diff --git a/driver.rkt b/driver.rkt index c1b7ad0..901ba66 100644 --- a/driver.rkt +++ b/driver.rkt @@ -48,12 +48,12 @@ 'name-error 'no-error) (dns-message-questions r1) - (listset-union (dns-message-answers r1) (dns-message-answers r2)) - (listset-union (dns-message-authorities r1) (dns-message-authorities r2)) - (listset-union (dns-message-additional r1) (dns-message-additional r2)))) + (rr-listset-union (dns-message-answers r1) (dns-message-answers r2)) + (rr-listset-union (dns-message-authorities r1) (dns-message-authorities r2)) + (rr-listset-union (dns-message-additional r1) (dns-message-additional r2)))) -(define (listset-union xs1 xs2) - (set->list (set-union (list->set xs1) (list->set xs2)))) +(define (rr-listset-union xs1 xs2) + (rr-set->list (set-union (list->set xs1) (list->set xs2)))) ;; start-server : UInt16 RR ListOf -> Void ;; Starts a server that will answer questions received on the given @@ -121,9 +121,9 @@ 'no-recursion-available (if send-name-error? 'name-error 'no-error) (dns-message-questions request-message) - (set->list answers) - (set->list authorities) - (set->list additional))) + (rr-set->list answers) + (rr-set->list authorities) + (rr-set->list additional))) (define reply-packet (with-handlers ((exn? (lambda (e) diff --git a/simplified-driver.rkt b/simplified-driver.rkt index 7ad30ea..f6193ee 100644 --- a/simplified-driver.rkt +++ b/simplified-driver.rkt @@ -92,9 +92,9 @@ 'no-recursion-available (if send-name-error? 'name-error 'no-error) (dns-message-questions request-message) - (set->list answers) - (set->list authorities) - (set->list additional))) + (rr-set->list answers) + (rr-set->list authorities) + (rr-set->list additional))) (define (answer-question q make-reply) ;; Notice that we claim to be authoritative for our configured diff --git a/zonedb.rkt b/zonedb.rkt index 4e5c52e..d0a6629 100644 --- a/zonedb.rkt +++ b/zonedb.rkt @@ -14,6 +14,7 @@ referral-for additional-section/a filter-rrs + rr-set->list resolve) @@ -105,6 +106,13 @@ (else (set-filter (lambda (rr) (eqv? (rr-class rr) qclass)) filtered-by-type)))) filtered-by-type-and-class) +;; rr-set->list : SetOf -> ListOf +;; Like set->list, but places all CNAME records first. +;; This is apparently to work around bugs in old versions of BIND? +(define (rr-set->list rrs) + (append (set->list (filter-by-type rrs 'cname)) + (set->list (set-filter (lambda (rr) (not (eqv? (rr-type rr) 'cname))) rrs)))) + ;; QuestionResult Maybe -> QuestionResult ;; Add the supporting facts from r2 into r1, keeping r1's ;; question. Replaces the knowledge from r1 with the knowledge from