From 3ba14c7f05085357aab8a2a9cb09c453cf6bbc8e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se> Date: Wed, 1 Jun 2022 18:54:02 +0200 Subject: [PATCH] Wrote rr-data->bytes. --- dns.scm | 5 +++-- dns/types/rr.scm | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 35 insertions(+), 3 deletions(-) diff --git a/dns.scm b/dns.scm index 3873954..1531541 100644 --- a/dns.scm +++ b/dns.scm @@ -2,12 +2,13 @@ :use-module (dns types message) :use-module (dns types header) :use-module (dns types question) - ;; :use-module (dns types rr) + :use-module (dns types rr) :re-export (dns-message->bytes bytes->dns-message make-dns-message dns-message? make-dns-header dns-header? - make-dns-question dns-question?)) + make-dns-question dns-question? + make-dns-rr-data dns-rr-data?)) (module-use! (module-public-interface (current-module)) (resolve-interface '(dns types))) diff --git a/dns/types/rr.scm b/dns/types/rr.scm index d991501..5454282 100644 --- a/dns/types/rr.scm +++ b/dns/types/rr.scm @@ -8,10 +8,12 @@ :use-module (dns label) :use-module (dns enum) :use-module (dns types) + :use-module (rnrs bytevectors) :re-export (name type class ttl rdata) :export (make-dns-rr-data dns-rr-data? - bytes->rr-data) + bytes->rr-data + rr-data->bytes) ) (define-record-type dns-rr-data @@ -68,3 +70,32 @@ (else (bv-get bv rdlength))) (return (make-dns-rr-data name: name type: type class: class ttl: ttl rdata: rdata)))) + + +(define (rr-data->bytes rr) + (define rr-bv + (case (type rr) + ((A) (uint-list->bytevector (list (inet-pton AF_INET (rdata rr))) + (endianness big) + 4)) + ((AAAA) (uint-list->bytevector (list (inet-pton AF_INET6 (rdata rr))) + (endianness big) + (/ 128 8))) + ((NS CNAME PTR TXT) + (string-list->labels (list (rdata rr)))) + (else (if (bytevector? (rdata rr)) + (rdata rr) + (scm-error 'misc-error "rr-data->bytes" + "Can't encode unknown type, which isn't a bytevector! type: ~a, rdata: ~s" + (list (type rr) (rdata rr)) #f) + )))) + + + (do + (bv-copy! (string-list->labels (string-split (name rr) #\.))) ; name + (u16! (rr->int (type rr))) ; type + (u16! (class->int (class rr))) ; class + (u32! (ttl rr)) ; ttl + (u16! (bytevector-length rr-bv)) ; rdlength + (bv-copy! rr-bv) ; rdata + )) -- GitLab