Remove misleading and wrong (answer-available?) predicate
This commit is contained in:
parent
58b8d9c35b
commit
f07495520e
|
@ -35,7 +35,8 @@
|
||||||
(resolve-from-zone (question
|
(resolve-from-zone (question
|
||||||
;;'(#"www" #"google" #"com")
|
;;'(#"www" #"google" #"com")
|
||||||
;;'(#"foo" #"rallyx" #"ccs" #"neu" #"edu")
|
;;'(#"foo" #"rallyx" #"ccs" #"neu" #"edu")
|
||||||
'(#"rallyx" #"ccs" #"neu" #"edu")
|
;;'(#"rallyx" #"ccs" #"neu" #"edu")
|
||||||
|
'(#"www" #"eighty-twenty" #"org")
|
||||||
'a
|
'a
|
||||||
'in)
|
'in)
|
||||||
(compile-zone-db
|
(compile-zone-db
|
||||||
|
|
|
@ -40,10 +40,6 @@
|
||||||
;;
|
;;
|
||||||
;; - See RFC 1035 section 7.1.
|
;; - 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
|
;; QuestionResult Maybe<QuestionResult> -> QuestionResult
|
||||||
;; Add the supporting facts from r2 into r1, keeping r1's
|
;; Add the supporting facts from r2 into r1, keeping r1's
|
||||||
;; question. Replaces the knowledge from r1 with the knowledge from
|
;; question. Replaces the knowledge from r1 with the knowledge from
|
||||||
|
@ -60,9 +56,9 @@
|
||||||
(set-union u1 u2)
|
(set-union u1 u2)
|
||||||
(set-union d1 d2))]))
|
(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)
|
(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 filtered-rrs (filter-rrs rrset qtype qclass))
|
||||||
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
|
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
|
||||||
(define base-reply (question-result q
|
(define base-reply (question-result q
|
||||||
|
@ -74,18 +70,22 @@
|
||||||
(set))
|
(set))
|
||||||
(set)))
|
(set)))
|
||||||
;; Algorithm for CNAME expansion from RFC 1034 4.3.2 step 3a.
|
;; Algorithm for CNAME expansion from RFC 1034 4.3.2 step 3a.
|
||||||
(if (and (not (set-empty? cnames)) (not (eqv? qtype 'cname)))
|
(define expanded-reply
|
||||||
(foldl (lambda (cname-rr current-reply)
|
(if (and (not (set-empty? cnames)) (not (eqv? qtype 'cname)))
|
||||||
(merge-replies current-reply
|
(foldl (lambda (cname-rr current-reply)
|
||||||
(resolve-from-zone
|
(merge-replies current-reply
|
||||||
(question (rr-rdata cname-rr) qtype qclass)
|
(resolve-from-zone
|
||||||
zone
|
(question (rr-rdata cname-rr) qtype qclass)
|
||||||
start-of-authority
|
zone
|
||||||
recursion-desired?
|
start-of-authority
|
||||||
(set))))
|
recursion-desired?
|
||||||
base-reply
|
(set))))
|
||||||
(set->list cnames))
|
base-reply
|
||||||
base-reply))
|
(set->list cnames))
|
||||||
|
base-reply))
|
||||||
|
(if (set-empty? (question-result-answers expanded-reply))
|
||||||
|
(kf)
|
||||||
|
expanded-reply))
|
||||||
|
|
||||||
(define (closest-nameservers name zone)
|
(define (closest-nameservers name zone)
|
||||||
(let search ((name name))
|
(let search ((name name))
|
||||||
|
@ -184,21 +184,21 @@
|
||||||
(additional-section/a zone (set-map ns-rrset rr-rdata))))
|
(additional-section/a zone (set-map ns-rrset rr-rdata))))
|
||||||
|
|
||||||
(define (resolve-from-zone q zone start-of-authority recursion-desired? nameservers-tried)
|
(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?
|
||||||
(answer-from-zone q zone start-of-authority recursion-desired?)
|
(lambda ()
|
||||||
(let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
|
(let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
|
||||||
(if (null? best-nameservers)
|
(if (null? best-nameservers)
|
||||||
(empty-answer q zone start-of-authority)
|
(empty-answer q zone start-of-authority)
|
||||||
(if recursion-desired?
|
(if recursion-desired?
|
||||||
(let ((best-nameserver (random-element best-nameservers)))
|
(let ((best-nameserver (random-element best-nameservers)))
|
||||||
(define enhanced-zone (network-query q zone best-nameserver))
|
(define enhanced-zone (network-query q zone best-nameserver))
|
||||||
(if (eq? enhanced-zone #f)
|
(if (eq? enhanced-zone #f)
|
||||||
;; name-error received!
|
;; name-error received!
|
||||||
#f
|
#f
|
||||||
;; we presumably learned something that might help us
|
;; we presumably learned something that might help us
|
||||||
(resolve-from-zone q
|
(resolve-from-zone q
|
||||||
enhanced-zone
|
enhanced-zone
|
||||||
start-of-authority
|
start-of-authority
|
||||||
recursion-desired?
|
recursion-desired?
|
||||||
(set-add nameservers-tried best-nameserver))))
|
(set-add nameservers-tried best-nameserver))))
|
||||||
(build-referral q zone start-of-authority (list->set best-nameservers)))))))
|
(build-referral q zone start-of-authority (list->set best-nameservers))))))))
|
||||||
|
|
Loading…
Reference in New Issue