diff --git a/driver.rkt b/driver.rkt index 8f94a83..c1b7ad0 100644 --- a/driver.rkt +++ b/driver.rkt @@ -9,6 +9,7 @@ (require "../racket-bitsyntax/main.rkt") (require "api.rkt") (require "codec.rkt") +(require "zonedb.rkt") (require "dump-bytes.rkt") ;; Instantiated with a SOA record for the zone it is serving as well @@ -24,64 +25,11 @@ ;; determines subzones based on the RRs it is configured with at ;; startup. -;; TODO: maybe store domain names big-end first? It'd make bailiwick -;; and subzone checks into prefix rather than suffix checks. It makes -;; domain names into paths through the DNS DB tree. - -;; compile-db : ListOf -> Hash> -;; Builds an immutable hash table from the given RRs, suitable for -;; quickly looking up answers to queries. -(define (compile-db rrs) - ;; RR Hash -> Hash - (define (incorporate-rr rr db) - (hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) (set)) rr))) - (foldl incorporate-rr (make-immutable-hash) rrs)) - -(define (in-bailiwick? dn root) - (cond - ((equal? dn root) #t) - ((null? dn) #f) - (else (in-bailiwick? (cdr dn) root)))) - (define (authoritativeness-for dn soa-rr) (if (in-bailiwick? dn (rr-name soa-rr)) 'authoritative 'non-authoritative)) -(define (filter-by-type rrset type) - (set-filter (lambda (rr) (eqv? (rr-type rr) type)) rrset)) - -(define (referral-for name soa-rr zone) - (define limit (rr-name soa-rr)) - (let search ((name name)) - (cond - ((or (null? name) (equal? name limit)) - ;; We've walked up the tree to the top of the zone. No referrals - ;; are possible. - #f) - ((hash-ref zone name #f) => - ;; There's an entry for this suffix of the original name. Check - ;; to see if it has an NS record indicating a subzone. - (lambda (rrset) - (define ns-rrset (filter-by-type rrset 'ns)) - (if (set-empty? ns-rrset) - (search (cdr name)) ;; no NS records for this suffix. Keep looking. - ns-rrset))) - (else - ;; Nothing for this suffix. Keep lookup. - (search (cdr name)))))) - -(define (additional-section/a zone names) - ;; RFC 3596 (section 3) requires that we process AAAA here as well - ;; as A. - (foldl (lambda (name section) - (set-union section - (set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa)) - (eqv? (rr-class rr) 'in))) - (hash-ref zone name)))) - (set) - names)) - ;; ASSUMPTION: r1 and r2 are both DNS replies to the same query. ;; ASSUMPTION: no response-codes other than no-error or name-error are in use. (define (merge-replies r1 r2) @@ -107,28 +55,6 @@ (define (listset-union xs1 xs2) (set->list (set-union (list->set xs1) (list->set xs2)))) -;; set-filter : (X -> Boolean) SetOf -> SetOf -;; Retains only those elements of its argument for which the predicate -;; answers #t. -(define (set-filter predicate in) - (for/set ([x (in-set in)] - #:when (predicate x)) - x)) - -;; filter-rrs : SetOf QueryType QueryClass -;; Returns a set like its argument with RRs not matching the given -;; type and class removed. -(define (filter-rrs rrs qtype qclass) - (define filtered-by-type - (case qtype - ((*) rrs) - (else (filter-by-type rrs qtype)))) - (define filtered-by-type-and-class - (case qclass - ((*) filtered-by-type) - (else (set-filter (lambda (rr) (eqv? (rr-class rr) qclass)) filtered-by-type)))) - filtered-by-type-and-class) - ;; start-server : UInt16 RR ListOf -> Void ;; Starts a server that will answer questions received on the given ;; UDP port based on the RRs it is given and the zone origin specified @@ -136,7 +62,7 @@ (require racket/pretty) (define (start-server port-number soa-rr rrs) ;; Compile the zone hash table - (define zone (compile-db (cons soa-rr rrs))) + (define zone (compile-zone-db (cons soa-rr rrs))) (pretty-print zone) diff --git a/zonedb.rkt b/zonedb.rkt new file mode 100644 index 0000000..74cb81d --- /dev/null +++ b/zonedb.rkt @@ -0,0 +1,102 @@ +#lang racket/base + +;; Noddy representation of a zone, and various zone and RRSet utilities. + +(require racket/set) +(require "api.rkt") +(require "codec.rkt") + +(provide compile-zone-db + in-bailiwick? + set-filter + filter-by-type + referral-for + additional-section/a + filter-rrs) + +;; A CompiledZone is a Hash>, representing a +;; collection of DNS RRSets indexed by DomainName. + +;; TODO: maybe store domain names big-end first? It'd make bailiwick +;; and subzone checks into prefix rather than suffix checks. It makes +;; domain names into paths through the DNS DB tree. + +;; compile-zone-db : ListOf -> CompiledZone +;; Builds an immutable hash table from the given RRs, suitable for +;; quickly looking up answers to queries. +(define (compile-zone-db rrs) + ;; RR Hash -> Hash + (define (incorporate-rr rr db) + (hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) (set)) rr))) + (foldl incorporate-rr (make-immutable-hash) rrs)) + +;; in-bailiwick? : DomainName DomainName -> Boolean +;; Answers #t iff dn falls within the bailiwick of the zone with +;; origin root. +(define (in-bailiwick? dn root) + (cond + ((equal? dn root) #t) + ((null? dn) #f) + (else (in-bailiwick? (cdr dn) root)))) + +;; set-filter : (X -> Boolean) SetOf -> SetOf +;; Retains only those elements of its argument for which the predicate +;; answers #t. +(define (set-filter predicate in) + (for/set ([x (in-set in)] + #:when (predicate x)) + x)) + +;; filter-by-type : SetOf RRType -> SetOf +;; Selects only those members of rrset having rr-type type. +(define (filter-by-type rrset type) + (set-filter (lambda (rr) (eqv? (rr-type rr) type)) rrset)) + +(define (referral-for name soa-rr zone) + (define limit (rr-name soa-rr)) + (let search ((name name)) + (cond + ((or (null? name) (equal? name limit)) + ;; We've walked up the tree to the top of the zone. No referrals + ;; are possible. + #f) + ((hash-ref zone name #f) => + ;; There's an entry for this suffix of the original name. Check + ;; to see if it has an NS record indicating a subzone. + (lambda (rrset) + (define ns-rrset (filter-by-type rrset 'ns)) + (if (set-empty? ns-rrset) + (search (cdr name)) ;; no NS records for this suffix. Keep looking. + ns-rrset))) + (else + ;; Nothing for this suffix. Keep lookup. + (search (cdr name)))))) + +;; additional-section/a : CompiledZone ListOf +;; Implements the "additional section" rules from RFC 1035 (and the +;; rules for IPv6 from RFC 3596). Provides A and AAAA records for +;; names mentioned in the "names" list that have entries in "zone". +(define (additional-section/a zone names) + ;; RFC 3596 (section 3) requires that we process AAAA here as well + ;; as A. + (foldl (lambda (name section) + (set-union section + (set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa)) + (eqv? (rr-class rr) 'in))) + (hash-ref zone name)))) + (set) + names)) + +;; filter-rrs : SetOf QueryType QueryClass +;; Returns a set like its argument with RRs not matching the given +;; type and class removed. +(define (filter-rrs rrs qtype qclass) + (define filtered-by-type + (case qtype + ((*) rrs) + (else (filter-by-type rrs qtype)))) + (define filtered-by-type-and-class + (case qclass + ((*) filtered-by-type) + (else (set-filter (lambda (rr) (eqv? (rr-class rr) qclass)) filtered-by-type)))) + filtered-by-type-and-class)