Distinguish between NS and CNAME subquestions.
This commit is contained in:
parent
6226ed01d5
commit
ef9078e1a3
70
api.rkt
70
api.rkt
|
@ -8,8 +8,11 @@
|
||||||
|
|
||||||
(struct-out question)
|
(struct-out question)
|
||||||
question-cyclic?
|
question-cyclic?
|
||||||
|
question-too-glueless?
|
||||||
question-restarted?
|
question-restarted?
|
||||||
restart-question
|
restart-question
|
||||||
|
cname-question
|
||||||
|
ns-question
|
||||||
|
|
||||||
(struct-out answered-question)
|
(struct-out answered-question)
|
||||||
(struct-out rr)
|
(struct-out rr)
|
||||||
|
@ -62,17 +65,28 @@
|
||||||
;; is represented as (vector #x20 #x01 #x0d #xb8 #x85 #xa3 #x00 #x00
|
;; is represented as (vector #x20 #x01 #x0d #xb8 #x85 #xa3 #x00 #x00
|
||||||
;; #x00 #x00 #x8a #x2e #x03 #x70 #x73 #x34).
|
;; #x00 #x00 #x8a #x2e #x03 #x70 #x73 #x34).
|
||||||
|
|
||||||
;; A Question is a (question DomainName QueryType QueryClass (or
|
;; A Question is a (question DomainName QueryType QueryClass
|
||||||
;; Question #f 'restart)), representing a DNS question: "What are the
|
;; QuestionContext), representing a DNS question: "What are the RRs
|
||||||
;; RRs for the given name, type and class?" as well as a possible
|
;; for the given name, type and class?" as well as a possible parent
|
||||||
;; parent question that the answer to this question is to contribute
|
;; question that the answer to this question is to contribute to the
|
||||||
;; to the answer to. The context is needed to break cycles in the DNS
|
;; answer to.
|
||||||
;; database. If the context is 'restart, then the question results
|
|
||||||
;; from an excessively-glueless subquestion, and should *not* in turn
|
|
||||||
;; be considered for gluelessness-restarting: this is needed to avoid
|
|
||||||
;; a different kind of infinite loop.
|
|
||||||
(struct question (name type class context) #:transparent)
|
(struct question (name type class context) #:transparent)
|
||||||
|
|
||||||
|
;; A QuestionContext is one of
|
||||||
|
;; -- (cname-subq Question), resulting from the expansion of a CNAME
|
||||||
|
;; -- (ns-subq Question), resulting from a network referral
|
||||||
|
;; -- #f, an original question from a remote peer
|
||||||
|
;; -- 'restart, a restarted question.
|
||||||
|
;;
|
||||||
|
;; The context is needed to break cycles in the DNS database. If the
|
||||||
|
;; context chain ends in 'restart, then the question results from an
|
||||||
|
;; excessively-glueless subquestion not represented here, and should
|
||||||
|
;; *not* in turn be considered for gluelessness-restarting: this is
|
||||||
|
;; needed to avoid a different kind of infinite loop.
|
||||||
|
(struct subquestion (parent) #:transparent)
|
||||||
|
(struct cname-subq subquestion () #:transparent)
|
||||||
|
(struct ns-subq subquestion () #:transparent)
|
||||||
|
|
||||||
;; An AnsweredQuestion is an (answered-question Question
|
;; An AnsweredQuestion is an (answered-question Question
|
||||||
;; Maybe<CompleteAnswer>).
|
;; Maybe<CompleteAnswer>).
|
||||||
(struct answered-question (q a) #:transparent)
|
(struct answered-question (q a) #:transparent)
|
||||||
|
@ -235,10 +249,31 @@
|
||||||
(match-define (question name type class parent) q)
|
(match-define (question name type class parent) q)
|
||||||
(let search ((ancestor parent))
|
(let search ((ancestor parent))
|
||||||
(match ancestor
|
(match ancestor
|
||||||
[(question (== name) (== type) (== class) _) #t] ;; uh-oh! A cycle!
|
[(subquestion (question (== name) (== type) (== class) _)) #t] ;; uh-oh! A cycle!
|
||||||
[(question _ _ _ ancestor-parent) (search ancestor-parent)] ;; recursive case
|
[(subquestion (question _ _ _ ancestor-parent)) (search ancestor-parent)] ;; recursive case
|
||||||
[_ #f]))) ;; no further parents -> definitely not cyclic
|
[_ #f]))) ;; no further parents -> definitely not cyclic
|
||||||
|
|
||||||
|
;; Question -> Boolean
|
||||||
|
;; If we're looking up a nameserver's address, in order to look up a
|
||||||
|
;; nameserver's address, in order to answer some question, that came
|
||||||
|
;; from the outside world, then that's too glueless. See
|
||||||
|
;; http://cr.yp.to/djbdns/notes.html in the sections "Gluelessness"
|
||||||
|
;; and "Expiring glue".
|
||||||
|
(define (question-too-glueless? q)
|
||||||
|
(define count
|
||||||
|
(let search ((q q) (acc 0))
|
||||||
|
(match-define (question _ _ _ parent) q)
|
||||||
|
(cond
|
||||||
|
[(ns-subq? parent) (search (subquestion-parent parent) (+ acc 1))]
|
||||||
|
[(subquestion? parent) (search (subquestion-parent parent) acc)]
|
||||||
|
[else acc])))
|
||||||
|
(if (>= count 2)
|
||||||
|
;; We're (at least) at the right nesting level: now see if this
|
||||||
|
;; question was already the result of a restart. If so, we
|
||||||
|
;; grimly press on with it unchanged.
|
||||||
|
(not (question-restarted? q))
|
||||||
|
#f))
|
||||||
|
|
||||||
;; Question -> Boolean
|
;; Question -> Boolean
|
||||||
;; #t iff this question is being asked in the context of some
|
;; #t iff this question is being asked in the context of some
|
||||||
;; excessively glueless subquestion.
|
;; excessively glueless subquestion.
|
||||||
|
@ -246,7 +281,7 @@
|
||||||
(match-define (question name type class parent) q)
|
(match-define (question name type class parent) q)
|
||||||
(let search ((ancestor parent))
|
(let search ((ancestor parent))
|
||||||
(match ancestor
|
(match ancestor
|
||||||
[(question _ _ _ ancestor-parent) (search ancestor-parent)]
|
[(subquestion (question _ _ _ ancestor-parent)) (search ancestor-parent)]
|
||||||
['restart #t]
|
['restart #t]
|
||||||
[_ #f])))
|
[_ #f])))
|
||||||
|
|
||||||
|
@ -255,3 +290,14 @@
|
||||||
;; retracing from the roots in cases of excessive gluelessness.
|
;; retracing from the roots in cases of excessive gluelessness.
|
||||||
(define (restart-question q)
|
(define (restart-question q)
|
||||||
(struct-copy question q [context 'restart]))
|
(struct-copy question q [context 'restart]))
|
||||||
|
|
||||||
|
;; DomainName Question -> Question
|
||||||
|
;; Produces a new question with CNAME context.
|
||||||
|
(define (cname-question name q)
|
||||||
|
(match-define (question _ type class _) q)
|
||||||
|
(question name type class (cname-subq q)))
|
||||||
|
|
||||||
|
;; DomainName Question -> Question
|
||||||
|
;; Produces a new question with NS context.
|
||||||
|
(define (ns-question name q)
|
||||||
|
(question name 'a 'in (ns-subq q))) ;; TODO: 'aaaa ?
|
||||||
|
|
|
@ -175,7 +175,7 @@
|
||||||
[remaining-addresses (hash-ref known-addresses
|
[remaining-addresses (hash-ref known-addresses
|
||||||
current-name)]
|
current-name)]
|
||||||
[remaining-names remaining-names]))
|
[remaining-names remaining-names]))
|
||||||
(let ((subq (question current-name 'a 'in (network-request-question req)))) ;;TODO: 'aaaa?
|
(let ((subq (ns-question current-name (network-request-question req))))
|
||||||
(transition (struct-copy network-query-state w [remaining-names remaining-names])
|
(transition (struct-copy network-query-state w [remaining-names remaining-names])
|
||||||
(send-message subq)
|
(send-message subq)
|
||||||
(subscribe/fresh subscription-id
|
(subscribe/fresh subscription-id
|
||||||
|
|
18
proxy.rkt
18
proxy.rkt
|
@ -145,21 +145,6 @@
|
||||||
(unsubscribe wait-id)
|
(unsubscribe wait-id)
|
||||||
(send-message (answer->reply original-question answer)))])))]))
|
(send-message (answer->reply original-question answer)))])))]))
|
||||||
|
|
||||||
(define (question-too-glueless? q)
|
|
||||||
;; If we're looking up a nameserver's address,
|
|
||||||
;; in order to look up a nameserver's address,
|
|
||||||
;; in order to answer some question,
|
|
||||||
;; that came from the outside world, then that's too glueless.
|
|
||||||
;; See http://cr.yp.to/djbdns/notes.html in the sections
|
|
||||||
;; "Gluelessness" and "Expiring glue".
|
|
||||||
(match q
|
|
||||||
[(question _ _ _ (question _ _ _ (question _ _ _ _)))
|
|
||||||
;; We're (at least) at the right nesting level: now see if this
|
|
||||||
;; question was already the result of a restart. If so, we grimly
|
|
||||||
;; press on with it unchanged.
|
|
||||||
(not (question-restarted? q))]
|
|
||||||
[_ #f]))
|
|
||||||
|
|
||||||
(define (glueless-question-handler roots-only-zone q client-sock)
|
(define (glueless-question-handler roots-only-zone q client-sock)
|
||||||
;; Restart q, an overly-glueless question, from the roots.
|
;; Restart q, an overly-glueless question, from the roots.
|
||||||
(define restarted-question (restart-question q))
|
(define restarted-question (restart-question q))
|
||||||
|
@ -285,7 +270,8 @@
|
||||||
[(partial-answer base cnames)
|
[(partial-answer base cnames)
|
||||||
(transition (expanding-cnames q base (length cnames))
|
(transition (expanding-cnames q base (length cnames))
|
||||||
(map (lambda (cname)
|
(map (lambda (cname)
|
||||||
(define cname-q (question cname (question-type q) (question-class q) q))
|
;; TODO: record chains of CNAMEs to avoid pathologically-long chains
|
||||||
|
(define cname-q (cname-question cname q))
|
||||||
(list (send-message cname-q)
|
(list (send-message cname-q)
|
||||||
(subscribe/fresh subscription-id
|
(subscribe/fresh subscription-id
|
||||||
(message-handlers (expanding-cnames q acc remaining)
|
(message-handlers (expanding-cnames q acc remaining)
|
||||||
|
|
Loading…
Reference in New Issue