Proper datatype for domain-names -> case-insensitive comparison
This commit is contained in:
Tony Garnock-Jones
parent
517f0e604d
commit
4e7cc96d1b
52
api.rkt
52
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<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").
|
||||
;; (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<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.
|
||||
|
||||
|
|
@ -139,6 +156,33 @@
|
|||
#:backward-default value->class
|
||||
(* 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
|
||||
(define (empty-complete-answer)
|
||||
(complete-answer (set) (set) (set)))
|
||||
|
|
|
|||
|
|
@ -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<Natural> -> DomainName
|
||||
;; Bytes Bytes ListOf<Natural> -> ListOf<Bytes>
|
||||
;; 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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@
|
|||
'recursion-desired
|
||||
'no-recursion-available
|
||||
'no-error
|
||||
(list (question '(#"example") '* '*))
|
||||
(list (question (domain '(#"example")) '* '*))
|
||||
'()
|
||||
'()
|
||||
'()))
|
||||
|
|
|
|||
104
test-dns.rkt
104
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))))))
|
||||
|
|
|
|||
44
test-rrs.rkt
44
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
|
||||
|
|
|
|||
|
|
@ -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<X> -> SetOf<X>
|
||||
;; Retains only those elements of its argument for which the predicate
|
||||
|
|
|
|||
Loading…
Reference in New Issue