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

Remove misleading and wrong (answer-available?) predicate

This commit is contained in:
Tony Garnock-Jones 2012-01-24 14:18:42 -05:00
parent 58b8d9c35b
commit f07495520e
2 changed files with 38 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
resolver-test.rkt
View File

@ -35,7 +35,8 @@
(resolve-from-zone (question
;;'(#"www" #"google" #"com")
;;'(#"foo" #"rallyx" #"ccs" #"neu" #"edu")
'(#"rallyx" #"ccs" #"neu" #"edu")
;;'(#"rallyx" #"ccs" #"neu" #"edu")
'(#"www" #"eighty-twenty" #"org")
'a
'in)
(compile-zone-db

72
resolver-unit.rkt
View File

@ -40,10 +40,6 @@
;;
;; - See RFC 1035 section 7.1.
;; Question CompiledZone -> Boolean
(define (answer-available? q zone)
(hash-has-key? zone (question-name q)))
;; QuestionResult Maybe<QuestionResult> -> QuestionResult
;; Add the supporting facts from r2 into r1, keeping r1's
;; question. Replaces the knowledge from r1 with the knowledge from
@ -60,9 +56,9 @@
(set-union u1 u2)
(set-union d1 d2))]))
(define (answer-from-zone q zone start-of-authority recursion-desired?)
(define (answer-from-zone q zone start-of-authority recursion-desired? kf)
(match-define (question name qtype qclass) q)
(define rrset (hash-ref zone name))
(define rrset (hash-ref zone name set))
(define filtered-rrs (filter-rrs rrset qtype qclass))
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
(define base-reply (question-result q
@ -74,18 +70,22 @@
(set))
(set)))
;; Algorithm for CNAME expansion from RFC 1034 4.3.2 step 3a.
(if (and (not (set-empty? cnames)) (not (eqv? qtype 'cname)))
(foldl (lambda (cname-rr current-reply)
(merge-replies current-reply
(resolve-from-zone
(question (rr-rdata cname-rr) qtype qclass)
zone
start-of-authority
recursion-desired?
(set))))
base-reply
(set->list cnames))
base-reply))
(define expanded-reply
(if (and (not (set-empty? cnames)) (not (eqv? qtype 'cname)))
(foldl (lambda (cname-rr current-reply)
(merge-replies current-reply
(resolve-from-zone
(question (rr-rdata cname-rr) qtype qclass)
zone
start-of-authority
recursion-desired?
(set))))
base-reply
(set->list cnames))
base-reply))
(if (set-empty? (question-result-answers expanded-reply))
(kf)
expanded-reply))
(define (closest-nameservers name zone)
(let search ((name name))
@ -184,21 +184,21 @@
(additional-section/a zone (set-map ns-rrset rr-rdata))))
(define (resolve-from-zone q zone start-of-authority recursion-desired? nameservers-tried)
(if (answer-available? q zone)
(answer-from-zone q zone start-of-authority recursion-desired?)
(let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
(if (null? best-nameservers)
(empty-answer q zone start-of-authority)
(if recursion-desired?
(let ((best-nameserver (random-element best-nameservers)))
(define enhanced-zone (network-query q zone best-nameserver))
(if (eq? enhanced-zone #f)
;; name-error received!
#f
;; we presumably learned something that might help us
(resolve-from-zone q
enhanced-zone
start-of-authority
recursion-desired?
(set-add nameservers-tried best-nameserver))))
(build-referral q zone start-of-authority (list->set best-nameservers)))))))
(answer-from-zone q zone start-of-authority recursion-desired?
(lambda ()
(let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
(if (null? best-nameservers)
(empty-answer q zone start-of-authority)
(if recursion-desired?
(let ((best-nameserver (random-element best-nameservers)))
(define enhanced-zone (network-query q zone best-nameserver))
(if (eq? enhanced-zone #f)
;; name-error received!
#f
;; we presumably learned something that might help us
(resolve-from-zone q
enhanced-zone
start-of-authority
recursion-desired?
(set-add nameservers-tried best-nameserver))))
(build-referral q zone start-of-authority (list->set best-nameservers))))))))