diff --git a/dns/types/header.scm b/dns/types/header.scm index f4484c823e3701b7798a3934ad136ef93c1aafac..9784c10d7c1782c73fb1003987c5c90dd7fd1ecc 100644 --- a/dns/types/header.scm +++ b/dns/types/header.scm @@ -59,14 +59,13 @@ (logand #xF u16))) ; rcode (define* (dns-header->bytes msg optional: (bv (make-bytevector 12))) - (define e (endianness big)) - (bytevector-u16-set! bv 0 (or (id msg) 0) e) - (bytevector-u16-set! bv 2 (encode-dns-header-flags msg) e) - (bytevector-u16-set! bv 4 (or (qdcount msg) 0) e) - (bytevector-u16-set! bv 6 (or (ancount msg) 0) e) - (bytevector-u16-set! bv 8 (or (nscount msg) 0) e) - (bytevector-u16-set! bv 10 (or (arcount msg) 0) e) - bv) + (do + (u16! (or (id msg) 0)) + (u16! (encode-dns-header-flags msg)) + (u16! (or (qdcount msg) 0)) + (u16! (or (ancount msg) 0)) + (u16! (or (nscount msg) 0)) + (u16! (or (arcount msg) 0)))) (define (bytes->dns-header bv) (do diff --git a/dns/types/message.scm b/dns/types/message.scm index 937f54d4bcd7a2ef8c98071a230c0c963e8ad4d3..40c4e51fdef69e16824e781ebe1768589ec7486d 100644 --- a/dns/types/message.scm +++ b/dns/types/message.scm @@ -32,16 +32,11 @@ (define (dns-message->bytes msg) - (define bvs - (cons (dns-header->bytes (header msg)) - (map dns-question->bytes (questions msg)))) - (define bv (make-bytevector (apply + (map bytevector-length bvs)))) - (fold-left (lambda (off v) - (bytevector-copy! v 0 bv off (bytevector-length v)) - (bytevector-length v)) - 0 - bvs) - bv) + (do (dns-header->bytes (header msg)) + (sequence (map dns-question->bytes (questions msg))) + (sequence (map rr-data->bytes (answers msg))) + (sequence (map rr-data->bytes (authorities msg))) + (sequence (map rr-data->bytes (additionals msg))))) (define (bytes->dns-message bv) (do diff --git a/dns/types/question.scm b/dns/types/question.scm index c270df297ac0f2d6c44b498ab44da5b1b5595572..b41576d9f5517c43b758374091aa13dbdb1c4001 100644 --- a/dns/types/question.scm +++ b/dns/types/question.scm @@ -25,18 +25,9 @@ (class default: 'IN type: (or u16? (assq (@ (dns enum) class-types)))))) (define (dns-question->bytes q) - (define bv-base (-> q - name - (string-split #\.) - string-list->labels)) - (define bv (make-bytevector (+ 4 (bytevector-length bv-base)))) - (bytevector-copy! bv-base 0 bv 0 (bytevector-length bv-base)) - (bytevector-u16-set! bv (+ 0 (bytevector-length bv-base)) - (rr->int (type q)) - (endianness big)) - (bytevector-u16-set! bv (+ 2 (bytevector-length bv-base)) - (class->int (class q)) (endianness big)) - bv) + (do (bv-copy! (-> q name (string-split #\.) string-list->labels)) + (u16! (rr->int (type q))) + (u16! (class->int (class q))))) (define (bytes->dns-question bv) (do