From 4e7cc96d1becf55e37f18ccf9afd50fcabb84542 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 17 Feb 2012 12:12:48 -0500 Subject: [PATCH] Proper datatype for domain-names -> case-insensitive comparison --- api.rkt | 52 ++++++++++++++++++++++++-- codec.rkt | 7 ++-- driver.rkt | 2 +- proxy.rkt | 2 +- resolver.rkt | 6 +-- stress.rkt | 2 +- test-dns.rkt | 104 +++++++++++++++++++++++++-------------------------- test-rrs.rkt | 44 +++++++++++----------- zonedb.rkt | 5 ++- 9 files changed, 135 insertions(+), 89 deletions(-) diff --git a/api.rkt b/api.rkt index cdb9e83..addec05 100644 --- a/api.rkt +++ b/api.rkt @@ -1,7 +1,12 @@ #lang racket/base ;; Definitions for use in the API to the functionality of the library. -(provide (struct-out question) +(provide (except-out (struct-out domain) domain) + (rename-out [make-domain domain]) + domain-root? + domain-parent + + (struct-out question) (struct-out answered-question) (struct-out rr) @@ -26,9 +31,21 @@ (require racket/set) (require racket/match) -;; A DomainName is a ListOf, representing a domain name. The -;; head of the list is the leftmost label; for example, www.google.com -;; is represented as '(#"www" #"google" #"com"). +;; (These utilities need to be defined ahead of the domain struct +;; definition.) +(define (domain=? a b recursive-equal?) + (recursive-equal? (domain-downcased-labels a) + (domain-downcased-labels b))) + +(define (domain-hash-1/2 d recursive-hash) + (recursive-hash (domain-downcased-labels d))) + +;; A DomainName is a (domain ListOf), representing a domain +;; name. The head of the list is the leftmost label; for example, +;; www.google.com is represented as '(#"www" #"google" #"com"). +(struct domain (labels downcased-labels) + #:transparent + #:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2)) ;; A ShortString is a String with length 255 or shorter. @@ -139,6 +156,33 @@ #:backward-default value->class (* 255)) +;; ListOf -> ListOf +;; Converts the 7-bit ASCII bytes in the argument to lower-case +;; equivalents. Used to normalize case for domain-name comparisons. +(define (downcase-labels labels) + (for/list ([label labels]) + (define b (make-bytes (bytes-length label))) + (for ([i (bytes-length label)]) + (define v (bytes-ref label i)) + (bytes-set! b i (if (<= 65 v 90) (+ 32 v) v))) + b)) + +;; ListOf -> DomainName +;; Replacement constructor for domain structs. Automatically downcases +;; labels appropriately. +(define (make-domain labels) + (domain labels (downcase-labels labels))) + +;; DomainName -> Boolean +(define (domain-root? d) + (null? (domain-labels d))) + +;; DomainName -> Maybe +(define (domain-parent d) + (and (pair? (domain-labels d)) + (domain (cdr (domain-labels d)) + (cdr (domain-downcased-labels d))))) + ;; -> CompleteAnswer (define (empty-complete-answer) (complete-answer (set) (set) (set))) diff --git a/codec.rkt b/codec.rkt index 4cd7d33..898ff29 100644 --- a/codec.rkt +++ b/codec.rkt @@ -225,16 +225,17 @@ ((_ #t whole-packet) (lambda (input ks kf) (let-values (((name rest) (parse-domain-name whole-packet input '()))) - (ks name rest)))) + (ks (domain name) rest)))) ((_ #f) encode-domain-name))) ;; DomainName -> Bitstring -(define (encode-domain-name labels) +(define (encode-domain-name name) + (define labels (domain-labels name)) (bit-string (labels :: (t:listof (t:pascal-string "Label" 64))) (0 :: integer bytes 1))) ;; end of list of labels! -;; Bytes Bytes ListOf -> DomainName +;; Bytes Bytes ListOf -> ListOf ;; PRECONDITION: input never empty ;; INVARIANT: pointers-followed contains every "jump target" we have ;; jumped to so far during decoding of this domain-name, in order to diff --git a/driver.rkt b/driver.rkt index 6137d88..abfa539 100644 --- a/driver.rkt +++ b/driver.rkt @@ -67,7 +67,7 @@ (define (first-only xs) (if (null? xs) xs - (cons (car xs) '()))) + (list (car xs)))) (define (handle-request soa-rr zone request) (match-define (dns-request request-message request-source request-sink) request) diff --git a/proxy.rkt b/proxy.rkt index 67c0ac5..886dcf0 100644 --- a/proxy.rkt +++ b/proxy.rkt @@ -150,7 +150,7 @@ (display "----------------------------------------------------------------------\n") (display (seconds->date (current-seconds))) (newline) - (for* ([(domain rrmap) zone] [(rr expiry) rrmap]) + (for* ([(name rrmap) zone] [(rr expiry) rrmap]) (write (list rr expiry)) (newline)) (newline)) diff --git a/resolver.rkt b/resolver.rkt index 21786f3..1e47e90 100644 --- a/resolver.rkt +++ b/resolver.rkt @@ -87,14 +87,14 @@ (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. + (search (domain-parent name)) ;; no NS records for this suffix. Keep looking. ns-rrset))) - ((null? name) + ((domain-root? name) ;; The root, and we don't have an RRSet for it. Give up. (set)) (else ;; Remove a label and keep looking. - (search (cdr name)))))) + (search (domain-parent name)))))) ;; Returns a set of NS RRs in an arbitrary order. (define (closest-untried-nameservers q zone nameservers-tried) diff --git a/stress.rkt b/stress.rkt index f2cb81b..e6ef081 100644 --- a/stress.rkt +++ b/stress.rkt @@ -36,7 +36,7 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"example") '* '*)) + (list (question (domain '(#"example")) '* '*)) '() '() '())) diff --git a/test-dns.rkt b/test-dns.rkt index 743b1c7..45e3e83 100644 --- a/test-dns.rkt +++ b/test-dns.rkt @@ -119,7 +119,7 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"google" #"com") '* 'in)) + (list (question (domain '(#"google" #"com")) '* 'in)) '() '() '())) @@ -134,32 +134,32 @@ 'recursion-desired 'recursion-available 'no-error - (list (question '(#"google" #"com") '* 'in)) + (list (question (domain '(#"google" #"com")) '* 'in)) (list - (rr '(#"google" #"com") 'txt 'in 3119 '(#"v=spf1 include:_netblocks.google.com ip4:216.73.93.70/31 ip4:216.73.93.72/31 ~all")) - (rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 146)) - (rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 148)) - (rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 145)) - (rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 147)) - (rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 144)) - (rr '(#"google" #"com") 'ns 'in 238877 '(#"ns2" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 238877 '(#"ns3" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 238877 '(#"ns1" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 238877 '(#"ns4" #"google" #"com")) - (rr '(#"google" #"com") 'mx 'in 42 (mx 20 '(#"alt1" #"aspmx" #"l" #"google" #"com"))) - (rr '(#"google" #"com") 'mx 'in 42 (mx 30 '(#"alt2" #"aspmx" #"l" #"google" #"com"))) - (rr '(#"google" #"com") 'mx 'in 42 (mx 10 '(#"aspmx" #"l" #"google" #"com"))) - (rr '(#"google" #"com") 'mx 'in 42 (mx 40 '(#"alt3" #"aspmx" #"l" #"google" #"com"))) - (rr '(#"google" #"com") 'mx 'in 42 (mx 50 '(#"alt4" #"aspmx" #"l" #"google" #"com")))) + (rr (domain '(#"google" #"com")) 'txt 'in 3119 '(#"v=spf1 include:_netblocks.google.com ip4:216.73.93.70/31 ip4:216.73.93.72/31 ~all")) + (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 146)) + (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 148)) + (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 145)) + (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 147)) + (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 144)) + (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns2" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns3" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns1" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns4" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 20 (domain '(#"alt1" #"aspmx" #"l" #"google" #"com")))) + (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 30 (domain '(#"alt2" #"aspmx" #"l" #"google" #"com")))) + (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 10 (domain '(#"aspmx" #"l" #"google" #"com")))) + (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 40 (domain '(#"alt3" #"aspmx" #"l" #"google" #"com")))) + (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 50 (domain '(#"alt4" #"aspmx" #"l" #"google" #"com"))))) '() (list - (rr '(#"ns3" #"google" #"com") 'a 'in 238287 '#(216 239 36 10)) - (rr '(#"ns1" #"google" #"com") 'a 'in 238287 '#(216 239 32 10)) - (rr '(#"ns4" #"google" #"com") 'a 'in 238287 '#(216 239 38 10)) - (rr '(#"ns2" #"google" #"com") 'a 'in 238287 '#(216 239 34 10)) - (rr '(#"alt2" #"aspmx" #"l" #"google" #"com") 'a 'in 240 '#(74 125 39 27)) - (rr '(#"aspmx" #"l" #"google" #"com") 'a 'in 246 '#(74 125 115 27)) - (rr '(#"alt1" #"aspmx" #"l" #"google" #"com") 'a 'in 33 '#(74 125 77 27))))) + (rr (domain '(#"ns3" #"google" #"com")) 'a 'in 238287 '#(216 239 36 10)) + (rr (domain '(#"ns1" #"google" #"com")) 'a 'in 238287 '#(216 239 32 10)) + (rr (domain '(#"ns4" #"google" #"com")) 'a 'in 238287 '#(216 239 38 10)) + (rr (domain '(#"ns2" #"google" #"com")) 'a 'in 238287 '#(216 239 34 10)) + (rr (domain '(#"alt2" #"aspmx" #"l" #"google" #"com")) 'a 'in 240 '#(74 125 39 27)) + (rr (domain '(#"aspmx" #"l" #"google" #"com")) 'a 'in 246 '#(74 125 115 27)) + (rr (domain '(#"alt1" #"aspmx" #"l" #"google" #"com")) 'a 'in 33 '#(74 125 77 27))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Roundtrip tests @@ -229,7 +229,7 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"google" #"com") 'aaaa 'in)) + (list (question (domain '(#"google" #"com")) 'aaaa 'in)) '() '() '())) @@ -249,9 +249,9 @@ 'recursion-desired 'recursion-available 'no-error - (list (question '(#"google" #"com") 'aaaa 'in)) + (list (question (domain '(#"google" #"com")) 'aaaa 'in)) '() - (list (rr '(#"google" #"com") 'soa 'in 594 (soa '(#"ns1" #"google" #"com") '(#"dns-admin" #"google" #"com") 1454883 7200 1800 1209600 300))) + (list (rr (domain '(#"google" #"com")) 'soa 'in 594 (soa (domain '(#"ns1" #"google" #"com")) (domain '(#"dns-admin" #"google" #"com")) 1454883 7200 1800 1209600 300))) '())) ;; Wed Jun 29 21:05:03 2011 (4e0bcbbf): UDP: localhost sent 32 bytes: @@ -278,7 +278,7 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"www" #"google" #"com") 'aaaa 'in)) + (list (question (domain '(#"www" #"google" #"com")) 'aaaa 'in)) '() '() '())) @@ -297,8 +297,8 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"www" #"google" #"com") 'aaaa 'in)) - (list (rr '(#"www" #"google" #"com") 'cname 'in 604800 '(#"www" #"l" #"google" #"com"))) + (list (question (domain '(#"www" #"google" #"com")) 'aaaa 'in)) + (list (rr (domain '(#"www" #"google" #"com")) 'cname 'in 604800 (domain '(#"www" #"l" #"google" #"com")))) '() '())) @@ -327,9 +327,9 @@ 'recursion-desired 'no-recursion-available 'no-error - (list (question '(#"ipv6" #"google" #"com") 'aaaa 'in)) - (list (rr '(#"ipv6" #"google" #"com") 'cname 'in 604800 '(#"ipv6" #"l" #"google" #"com")) - (rr '(#"ipv6" #"l" #"google" #"com") 'aaaa 'in 300 '#(32 1 72 96 128 15 0 0 0 0 0 0 0 0 0 104))) + (list (question (domain '(#"ipv6" #"google" #"com")) 'aaaa 'in)) + (list (rr (domain '(#"ipv6" #"google" #"com")) 'cname 'in 604800 (domain '(#"ipv6" #"l" #"google" #"com"))) + (rr (domain '(#"ipv6" #"l" #"google" #"com")) 'aaaa 'in 300 '#(32 1 72 96 128 15 0 0 0 0 0 0 0 0 0 104))) '() '())) @@ -410,7 +410,7 @@ #x00 #x04 #xD8 #xEF #x22 #x0A #xC1 #x1A #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1 #x00 #x04 #xD8 #xEF #x24 #x0A #xC1 #x2C #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1 #x00 #x04 #xD8 #xEF #x26 #x0A) - (let ((X '(#"_xmpp-server" #"_tcp" #"google" #"com"))) + (let ((X (domain '(#"_xmpp-server" #"_tcp" #"google" #"com")))) (dns-message 5066 'response 'query @@ -420,21 +420,21 @@ 'recursion-available 'no-error (list (question X 'srv 'in)) - (list (rr X 'srv 'in 882 (srv 20 0 5269 '(#"xmpp-server4" #"l" #"google" #"com"))) - (rr X 'srv 'in 882 (srv 5 0 5269 '(#"xmpp-server" #"l" #"google" #"com"))) - (rr X 'srv 'in 882 (srv 20 0 5269 '(#"xmpp-server1" #"l" #"google" #"com"))) - (rr X 'srv 'in 882 (srv 20 0 5269 '(#"xmpp-server2" #"l" #"google" #"com"))) - (rr X 'srv 'in 882 (srv 20 0 5269 '(#"xmpp-server3" #"l" #"google" #"com")))) - (list (rr '(#"google" #"com") 'ns 'in 87076 '(#"ns3" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 87076 '(#"ns4" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 87076 '(#"ns2" #"google" #"com")) - (rr '(#"google" #"com") 'ns 'in 87076 '(#"ns1" #"google" #"com"))) - (list (rr '(#"xmpp-server" #"l" #"google" #"com") 'a 'in 282 '#(74 125 153 125)) - (rr '(#"xmpp-server1" #"l" #"google" #"com") 'a 'in 1782 '#(74 125 53 125)) - (rr '(#"xmpp-server2" #"l" #"google" #"com") 'a 'in 1782 '#(74 125 47 125)) - (rr '(#"xmpp-server3" #"l" #"google" #"com") 'a 'in 1782 '#(74 125 45 125)) - (rr '(#"xmpp-server4" #"l" #"google" #"com") 'a 'in 1782 '#(74 125 45 125)) - (rr '(#"ns1" #"google" #"com") 'a 'in 2737 '#(216 239 32 10)) - (rr '(#"ns2" #"google" #"com") 'a 'in 2737 '#(216 239 34 10)) - (rr '(#"ns3" #"google" #"com") 'a 'in 2737 '#(216 239 36 10)) - (rr '(#"ns4" #"google" #"com") 'a 'in 2737 '#(216 239 38 10)))))) + (list (rr X 'srv 'in 882 (srv 20 0 5269 (domain '(#"xmpp-server4" #"l" #"google" #"com")))) + (rr X 'srv 'in 882 (srv 5 0 5269 (domain '(#"xmpp-server" #"l" #"google" #"com")))) + (rr X 'srv 'in 882 (srv 20 0 5269 (domain '(#"xmpp-server1" #"l" #"google" #"com")))) + (rr X 'srv 'in 882 (srv 20 0 5269 (domain '(#"xmpp-server2" #"l" #"google" #"com")))) + (rr X 'srv 'in 882 (srv 20 0 5269 (domain '(#"xmpp-server3" #"l" #"google" #"com"))))) + (list (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns3" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns4" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns2" #"google" #"com"))) + (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns1" #"google" #"com")))) + (list (rr (domain '(#"xmpp-server" #"l" #"google" #"com")) 'a 'in 282 '#(74 125 153 125)) + (rr (domain '(#"xmpp-server1" #"l" #"google" #"com")) 'a 'in 1782 '#(74 125 53 125)) + (rr (domain '(#"xmpp-server2" #"l" #"google" #"com")) 'a 'in 1782 '#(74 125 47 125)) + (rr (domain '(#"xmpp-server3" #"l" #"google" #"com")) 'a 'in 1782 '#(74 125 45 125)) + (rr (domain '(#"xmpp-server4" #"l" #"google" #"com")) 'a 'in 1782 '#(74 125 45 125)) + (rr (domain '(#"ns1" #"google" #"com")) 'a 'in 2737 '#(216 239 32 10)) + (rr (domain '(#"ns2" #"google" #"com")) 'a 'in 2737 '#(216 239 34 10)) + (rr (domain '(#"ns3" #"google" #"com")) 'a 'in 2737 '#(216 239 36 10)) + (rr (domain '(#"ns4" #"google" #"com")) 'a 'in 2737 '#(216 239 38 10)))))) diff --git a/test-rrs.rkt b/test-rrs.rkt index f8fdbfd..f3fdde8 100644 --- a/test-rrs.rkt +++ b/test-rrs.rkt @@ -5,9 +5,9 @@ (provide test-soa-rr test-rrs test-roots test-port-number) (define test-soa-rr - (rr '(#"example") 'soa 'in 30 - (soa '(#"ns" #"example") - '(#"tonyg" #"example") + (rr (domain '(#"example")) 'soa 'in 30 + (soa (domain '(#"ns" #"example")) + (domain '(#"tonyg" #"example")) 1 24 24 @@ -15,27 +15,27 @@ 10))) (define test-rrs - (list (rr '(#"localhost" #"example") 'a 'in 30 '#(127 0 0 1)) - (rr '(#"example") 'mx 'in 30 (mx 5 '(#"localhost" #"example"))) - (rr '(#"example") 'mx 'in 30 (mx 10 '(#"subns" #"example"))) - (rr '(#"google" #"example") 'cname 'in 30 '(#"www" #"google" #"com")) - (rr '(#"roar" #"example") 'a 'in 30 '#(192 168 1 1)) - (rr '(#"alias" #"example") 'cname 'in 30 '(#"roar" #"example")) - (rr '(#"ns" #"example") 'a 'in 30 '#(127 0 0 1)) - (rr '(#"hello" #"example") 'txt 'in 30 '(#"Hello CRASH")) - (rr '(#"subzone" #"example") 'ns 'in 30 '(#"subns" #"example")) - (rr '(#"subns" #"example") 'a 'in 30 '#(127 0 0 2)))) + (list (rr (domain '(#"localhost" #"example")) 'a 'in 30 '#(127 0 0 1)) + (rr (domain '(#"example")) 'mx 'in 30 (mx 5 (domain '(#"localhost" #"example")))) + (rr (domain '(#"example")) 'mx 'in 30 (mx 10 (domain '(#"subns" #"example")))) + (rr (domain '(#"google" #"example")) 'cname 'in 30 (domain '(#"www" #"google" #"com"))) + (rr (domain '(#"roar" #"example")) 'a 'in 30 '#(192 168 1 1)) + (rr (domain '(#"alias" #"example")) 'cname 'in 30 (domain '(#"roar" #"example"))) + (rr (domain '(#"ns" #"example")) 'a 'in 30 '#(127 0 0 1)) + (rr (domain '(#"hello" #"example")) 'txt 'in 30 (domain '(#"Hello CRASH"))) + (rr (domain '(#"subzone" #"example")) 'ns 'in 30 (domain '(#"subns" #"example"))) + (rr (domain '(#"subns" #"example")) 'a 'in 30 '#(127 0 0 2)))) (define test-roots - (list (rr '() 'ns 'in 30 '(#"f" #"root-servers" #"net")) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(198 41 0 4)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 228 79 201)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 33 4 12)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 203 230 10)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 112 36 4)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(128 63 2 53)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 58 128 30)) - (rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(193 0 14 129)))) + (list (rr (domain '()) 'ns 'in 30 (domain '(#"f" #"root-servers" #"net"))) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(198 41 0 4)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 228 79 201)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 33 4 12)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 203 230 10)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 112 36 4)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(128 63 2 53)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 58 128 30)) + (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(193 0 14 129)))) (define (test-port-number) (string->number diff --git a/zonedb.rkt b/zonedb.rkt index 5be2964..5ac32ca 100644 --- a/zonedb.rkt +++ b/zonedb.rkt @@ -54,6 +54,7 @@ (inexact->exact (floor (- expiry now))))])))] [else #f])) +;; CompiledZone DomainName -> Boolean (define (zone-includes-name? db name) (hash-has-key? db name)) @@ -118,8 +119,8 @@ (define (in-bailiwick? dn o) (cond ((equal? dn o) #t) - ((null? dn) #f) - (else (in-bailiwick? (cdr dn) o)))) + ((domain-root? dn) #f) + (else (in-bailiwick? (domain-parent dn) o)))) ;; set-filter : (X -> Boolean) SetOf -> SetOf ;; Retains only those elements of its argument for which the predicate