syndicate-lang
/
racket-dns-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Proper datatype for domain-names -> case-insensitive comparison

This commit is contained in:
Tony Garnock-Jones 2012-02-17 12:12:48 -05:00
parent 517f0e604d
commit 4e7cc96d1b
9 changed files with 135 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
api.rkt
View File

@ -1,7 +1,12 @@
#lang racket/base #lang racket/base
;; Definitions for use in the API to the functionality of the library. ;; 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 answered-question)
(struct-out rr) (struct-out rr)
@ -26,9 +31,21 @@
(require racket/set) (require racket/set)
(require racket/match) (require racket/match)
;; A DomainName is a ListOf<Bytes>, representing a domain name. The ;; (These utilities need to be defined ahead of the domain struct
;; head of the list is the leftmost label; for example, www.google.com ;; definition.)
;; is represented as '(#"www" #"google" #"com"). (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<Bytes>), 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. ;; A ShortString is a String with length 255 or shorter.
@ -139,6 +156,33 @@
#:backward-default value->class #:backward-default value->class
(* 255)) (* 255))
;; ListOf<Bytes> -> ListOf<Bytes>
;; 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<Bytes> -> 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<DomainName>
(define (domain-parent d)
(and (pair? (domain-labels d))
(domain (cdr (domain-labels d))
(cdr (domain-downcased-labels d)))))
;; -> CompleteAnswer ;; -> CompleteAnswer
(define (empty-complete-answer) (define (empty-complete-answer)
(complete-answer (set) (set) (set))) (complete-answer (set) (set) (set)))

7
codec.rkt
View File

@ -225,16 +225,17 @@
((_ #t whole-packet) ((_ #t whole-packet)
(lambda (input ks kf) (lambda (input ks kf)
(let-values (((name rest) (parse-domain-name whole-packet input '()))) (let-values (((name rest) (parse-domain-name whole-packet input '())))
(ks name rest)))) (ks (domain name) rest))))
((_ #f) ((_ #f)
encode-domain-name))) encode-domain-name)))
;; DomainName -> Bitstring ;; 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))) (bit-string (labels :: (t:listof (t:pascal-string "Label" 64)))
(0 :: integer bytes 1))) ;; end of list of labels! (0 :: integer bytes 1))) ;; end of list of labels!
;; Bytes Bytes ListOf<Natural> -> DomainName ;; Bytes Bytes ListOf<Natural> -> ListOf<Bytes>
;; PRECONDITION: input never empty ;; PRECONDITION: input never empty
;; INVARIANT: pointers-followed contains every "jump target" we have ;; INVARIANT: pointers-followed contains every "jump target" we have
;; jumped to so far during decoding of this domain-name, in order to ;; jumped to so far during decoding of this domain-name, in order to

2
driver.rkt
View File

@ -67,7 +67,7 @@
(define (first-only xs) (define (first-only xs)
(if (null? xs) (if (null? xs)
xs xs
(cons (car xs) '()))) (list (car xs))))
(define (handle-request soa-rr zone request) (define (handle-request soa-rr zone request)
(match-define (dns-request request-message request-source request-sink) request) (match-define (dns-request request-message request-source request-sink) request)

2
proxy.rkt
View File

@ -150,7 +150,7 @@
(display "----------------------------------------------------------------------\n") (display "----------------------------------------------------------------------\n")
(display (seconds->date (current-seconds))) (display (seconds->date (current-seconds)))
(newline) (newline)
(for* ([(domain rrmap) zone] [(rr expiry) rrmap]) (for* ([(name rrmap) zone] [(rr expiry) rrmap])
(write (list rr expiry)) (write (list rr expiry))
(newline)) (newline))
(newline)) (newline))

6
resolver.rkt
View File

@ -87,14 +87,14 @@
(lambda (rrset) (lambda (rrset)
(define ns-rrset (filter-by-type rrset 'ns)) (define ns-rrset (filter-by-type rrset 'ns))
(if (set-empty? ns-rrset) (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))) ns-rrset)))
((null? name) ((domain-root? name)
;; The root, and we don't have an RRSet for it. Give up. ;; The root, and we don't have an RRSet for it. Give up.
(set)) (set))
(else (else
;; Remove a label and keep looking. ;; Remove a label and keep looking.
(search (cdr name)))))) (search (domain-parent name))))))
;; Returns a set of NS RRs in an arbitrary order. ;; Returns a set of NS RRs in an arbitrary order.
(define (closest-untried-nameservers q zone nameservers-tried) (define (closest-untried-nameservers q zone nameservers-tried)

2
stress.rkt
View File

@ -36,7 +36,7 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"example") '* '*)) (list (question (domain '(#"example")) '* '*))
'() '()
'() '()
'())) '()))

104
test-dns.rkt
View File

@ -119,7 +119,7 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"google" #"com") '* 'in)) (list (question (domain '(#"google" #"com")) '* 'in))
'() '()
'() '()
'())) '()))
@ -134,32 +134,32 @@
'recursion-desired 'recursion-desired
'recursion-available 'recursion-available
'no-error 'no-error
(list (question '(#"google" #"com") '* 'in)) (list (question (domain '(#"google" #"com")) '* 'in))
(list (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 (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 '(#"google" #"com") 'a 'in 285 '#(74 125 226 146)) (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 146))
(rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 148)) (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 148))
(rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 145)) (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 145))
(rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 147)) (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 147))
(rr '(#"google" #"com") 'a 'in 285 '#(74 125 226 144)) (rr (domain '(#"google" #"com")) 'a 'in 285 '#(74 125 226 144))
(rr '(#"google" #"com") 'ns 'in 238877 '(#"ns2" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns2" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 238877 '(#"ns3" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns3" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 238877 '(#"ns1" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns1" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 238877 '(#"ns4" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 238877 (domain '(#"ns4" #"google" #"com")))
(rr '(#"google" #"com") 'mx 'in 42 (mx 20 '(#"alt1" #"aspmx" #"l" #"google" #"com"))) (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 20 (domain '(#"alt1" #"aspmx" #"l" #"google" #"com"))))
(rr '(#"google" #"com") 'mx 'in 42 (mx 30 '(#"alt2" #"aspmx" #"l" #"google" #"com"))) (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 30 (domain '(#"alt2" #"aspmx" #"l" #"google" #"com"))))
(rr '(#"google" #"com") 'mx 'in 42 (mx 10 '(#"aspmx" #"l" #"google" #"com"))) (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 10 (domain '(#"aspmx" #"l" #"google" #"com"))))
(rr '(#"google" #"com") 'mx 'in 42 (mx 40 '(#"alt3" #"aspmx" #"l" #"google" #"com"))) (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 40 (domain '(#"alt3" #"aspmx" #"l" #"google" #"com"))))
(rr '(#"google" #"com") 'mx 'in 42 (mx 50 '(#"alt4" #"aspmx" #"l" #"google" #"com")))) (rr (domain '(#"google" #"com")) 'mx 'in 42 (mx 50 (domain '(#"alt4" #"aspmx" #"l" #"google" #"com")))))
'() '()
(list (list
(rr '(#"ns3" #"google" #"com") 'a 'in 238287 '#(216 239 36 10)) (rr (domain '(#"ns3" #"google" #"com")) 'a 'in 238287 '#(216 239 36 10))
(rr '(#"ns1" #"google" #"com") 'a 'in 238287 '#(216 239 32 10)) (rr (domain '(#"ns1" #"google" #"com")) 'a 'in 238287 '#(216 239 32 10))
(rr '(#"ns4" #"google" #"com") 'a 'in 238287 '#(216 239 38 10)) (rr (domain '(#"ns4" #"google" #"com")) 'a 'in 238287 '#(216 239 38 10))
(rr '(#"ns2" #"google" #"com") 'a 'in 238287 '#(216 239 34 10)) (rr (domain '(#"ns2" #"google" #"com")) 'a 'in 238287 '#(216 239 34 10))
(rr '(#"alt2" #"aspmx" #"l" #"google" #"com") 'a 'in 240 '#(74 125 39 27)) (rr (domain '(#"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 (domain '(#"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 '(#"alt1" #"aspmx" #"l" #"google" #"com")) 'a 'in 33 '#(74 125 77 27)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Roundtrip tests ;; Roundtrip tests
@ -229,7 +229,7 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"google" #"com") 'aaaa 'in)) (list (question (domain '(#"google" #"com")) 'aaaa 'in))
'() '()
'() '()
'())) '()))
@ -249,9 +249,9 @@
'recursion-desired 'recursion-desired
'recursion-available 'recursion-available
'no-error '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: ;; Wed Jun 29 21:05:03 2011 (4e0bcbbf): UDP: localhost sent 32 bytes:
@ -278,7 +278,7 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"www" #"google" #"com") 'aaaa 'in)) (list (question (domain '(#"www" #"google" #"com")) 'aaaa 'in))
'() '()
'() '()
'())) '()))
@ -297,8 +297,8 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"www" #"google" #"com") 'aaaa 'in)) (list (question (domain '(#"www" #"google" #"com")) 'aaaa 'in))
(list (rr '(#"www" #"google" #"com") 'cname 'in 604800 '(#"www" #"l" #"google" #"com"))) (list (rr (domain '(#"www" #"google" #"com")) 'cname 'in 604800 (domain '(#"www" #"l" #"google" #"com"))))
'() '()
'())) '()))
@ -327,9 +327,9 @@
'recursion-desired 'recursion-desired
'no-recursion-available 'no-recursion-available
'no-error 'no-error
(list (question '(#"ipv6" #"google" #"com") 'aaaa 'in)) (list (question (domain '(#"ipv6" #"google" #"com")) 'aaaa 'in))
(list (rr '(#"ipv6" #"google" #"com") 'cname 'in 604800 '(#"ipv6" #"l" #"google" #"com")) (list (rr (domain '(#"ipv6" #"google" #"com")) 'cname 'in 604800 (domain '(#"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))) (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 #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 #x24 #x0A #xC1 #x2C #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1
#x00 #x04 #xD8 #xEF #x26 #x0A) #x00 #x04 #xD8 #xEF #x26 #x0A)
(let ((X '(#"_xmpp-server" #"_tcp" #"google" #"com"))) (let ((X (domain '(#"_xmpp-server" #"_tcp" #"google" #"com"))))
(dns-message 5066 (dns-message 5066
'response 'response
'query 'query
@ -420,21 +420,21 @@
'recursion-available 'recursion-available
'no-error 'no-error
(list (question X 'srv 'in)) (list (question X 'srv 'in))
(list (rr X 'srv 'in 882 (srv 20 0 5269 '(#"xmpp-server4" #"l" #"google" #"com"))) (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 '(#"xmpp-server" #"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 '(#"xmpp-server1" #"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 '(#"xmpp-server2" #"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 '(#"xmpp-server3" #"l" #"google" #"com")))) (rr X 'srv 'in 882 (srv 20 0 5269 (domain '(#"xmpp-server3" #"l" #"google" #"com")))))
(list (rr '(#"google" #"com") 'ns 'in 87076 '(#"ns3" #"google" #"com")) (list (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns3" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 87076 '(#"ns4" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns4" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 87076 '(#"ns2" #"google" #"com")) (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns2" #"google" #"com")))
(rr '(#"google" #"com") 'ns 'in 87076 '(#"ns1" #"google" #"com"))) (rr (domain '(#"google" #"com")) 'ns 'in 87076 (domain '(#"ns1" #"google" #"com"))))
(list (rr '(#"xmpp-server" #"l" #"google" #"com") 'a 'in 282 '#(74 125 153 125)) (list (rr (domain '(#"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 (domain '(#"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 (domain '(#"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 (domain '(#"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 (domain '(#"xmpp-server4" #"l" #"google" #"com")) 'a 'in 1782 '#(74 125 45 125))
(rr '(#"ns1" #"google" #"com") 'a 'in 2737 '#(216 239 32 10)) (rr (domain '(#"ns1" #"google" #"com")) 'a 'in 2737 '#(216 239 32 10))
(rr '(#"ns2" #"google" #"com") 'a 'in 2737 '#(216 239 34 10)) (rr (domain '(#"ns2" #"google" #"com")) 'a 'in 2737 '#(216 239 34 10))
(rr '(#"ns3" #"google" #"com") 'a 'in 2737 '#(216 239 36 10)) (rr (domain '(#"ns3" #"google" #"com")) 'a 'in 2737 '#(216 239 36 10))
(rr '(#"ns4" #"google" #"com") 'a 'in 2737 '#(216 239 38 10)))))) (rr (domain '(#"ns4" #"google" #"com")) 'a 'in 2737 '#(216 239 38 10))))))

44
test-rrs.rkt
View File

@ -5,9 +5,9 @@
(provide test-soa-rr test-rrs test-roots test-port-number) (provide test-soa-rr test-rrs test-roots test-port-number)
(define test-soa-rr (define test-soa-rr
(rr '(#"example") 'soa 'in 30 (rr (domain '(#"example")) 'soa 'in 30
(soa '(#"ns" #"example") (soa (domain '(#"ns" #"example"))
'(#"tonyg" #"example") (domain '(#"tonyg" #"example"))
1 1
24 24
24 24
@ -15,27 +15,27 @@
10))) 10)))
(define test-rrs (define test-rrs
(list (rr '(#"localhost" #"example") 'a 'in 30 '#(127 0 0 1)) (list (rr (domain '(#"localhost" #"example")) 'a 'in 30 '#(127 0 0 1))
(rr '(#"example") 'mx 'in 30 (mx 5 '(#"localhost" #"example"))) (rr (domain '(#"example")) 'mx 'in 30 (mx 5 (domain '(#"localhost" #"example"))))
(rr '(#"example") 'mx 'in 30 (mx 10 '(#"subns" #"example"))) (rr (domain '(#"example")) 'mx 'in 30 (mx 10 (domain '(#"subns" #"example"))))
(rr '(#"google" #"example") 'cname 'in 30 '(#"www" #"google" #"com")) (rr (domain '(#"google" #"example")) 'cname 'in 30 (domain '(#"www" #"google" #"com")))
(rr '(#"roar" #"example") 'a 'in 30 '#(192 168 1 1)) (rr (domain '(#"roar" #"example")) 'a 'in 30 '#(192 168 1 1))
(rr '(#"alias" #"example") 'cname 'in 30 '(#"roar" #"example")) (rr (domain '(#"alias" #"example")) 'cname 'in 30 (domain '(#"roar" #"example")))
(rr '(#"ns" #"example") 'a 'in 30 '#(127 0 0 1)) (rr (domain '(#"ns" #"example")) 'a 'in 30 '#(127 0 0 1))
(rr '(#"hello" #"example") 'txt 'in 30 '(#"Hello CRASH")) (rr (domain '(#"hello" #"example")) 'txt 'in 30 (domain '(#"Hello CRASH")))
(rr '(#"subzone" #"example") 'ns 'in 30 '(#"subns" #"example")) (rr (domain '(#"subzone" #"example")) 'ns 'in 30 (domain '(#"subns" #"example")))
(rr '(#"subns" #"example") 'a 'in 30 '#(127 0 0 2)))) (rr (domain '(#"subns" #"example")) 'a 'in 30 '#(127 0 0 2))))
(define test-roots (define test-roots
(list (rr '() 'ns 'in 30 '(#"f" #"root-servers" #"net")) (list (rr (domain '()) 'ns 'in 30 (domain '(#"f" #"root-servers" #"net")))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(198 41 0 4)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(198 41 0 4))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 228 79 201)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 228 79 201))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 33 4 12)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 33 4 12))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 203 230 10)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 203 230 10))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 112 36 4)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 112 36 4))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(128 63 2 53)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(128 63 2 53))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(192 58 128 30)) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(192 58 128 30))
(rr '(#"f" #"root-servers" #"net") 'a 'in 30 '#(193 0 14 129)))) (rr (domain '(#"f" #"root-servers" #"net")) 'a 'in 30 '#(193 0 14 129))))
(define (test-port-number) (define (test-port-number)
(string->number (string->number

5
zonedb.rkt
View File

@ -54,6 +54,7 @@
(inexact->exact (floor (- expiry now))))])))] (inexact->exact (floor (- expiry now))))])))]
[else #f])) [else #f]))
;; CompiledZone DomainName -> Boolean
(define (zone-includes-name? db name) (define (zone-includes-name? db name)
(hash-has-key? db name)) (hash-has-key? db name))
@ -118,8 +119,8 @@
(define (in-bailiwick? dn o) (define (in-bailiwick? dn o)
(cond (cond
((equal? dn o) #t) ((equal? dn o) #t)
((null? dn) #f) ((domain-root? dn) #f)
(else (in-bailiwick? (cdr dn) o)))) (else (in-bailiwick? (domain-parent dn) o))))
;; set-filter : (X -> Boolean) SetOf<X> -> SetOf<X> ;; set-filter : (X -> Boolean) SetOf<X> -> SetOf<X>
;; Retains only those elements of its argument for which the predicate ;; Retains only those elements of its argument for which the predicate