diff --git a/api.rkt b/api.rkt index 926d3cd..16300ee 100644 --- a/api.rkt +++ b/api.rkt @@ -8,8 +8,11 @@ (struct-out question) question-cyclic? + question-too-glueless? question-restarted? restart-question + cname-question + ns-question (struct-out answered-question) (struct-out rr) @@ -62,17 +65,28 @@ ;; is represented as (vector #x20 #x01 #x0d #xb8 #x85 #xa3 #x00 #x00 ;; #x00 #x00 #x8a #x2e #x03 #x70 #x73 #x34). -;; A Question is a (question DomainName QueryType QueryClass (or -;; Question #f 'restart)), representing a DNS question: "What are the -;; RRs for the given name, type and class?" as well as a possible -;; parent question that the answer to this question is to contribute -;; to the answer to. The context is needed to break cycles in the DNS -;; 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. +;; A Question is a (question DomainName QueryType QueryClass +;; QuestionContext), representing a DNS question: "What are the RRs +;; for the given name, type and class?" as well as a possible parent +;; question that the answer to this question is to contribute to the +;; answer to. (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 ;; Maybe). (struct answered-question (q a) #:transparent) @@ -235,10 +249,31 @@ (match-define (question name type class parent) q) (let search ((ancestor parent)) (match ancestor - [(question (== name) (== type) (== class) _) #t] ;; uh-oh! A cycle! - [(question _ _ _ ancestor-parent) (search ancestor-parent)] ;; recursive case + [(subquestion (question (== name) (== type) (== class) _)) #t] ;; uh-oh! A cycle! + [(subquestion (question _ _ _ ancestor-parent)) (search ancestor-parent)] ;; recursive case [_ #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 ;; #t iff this question is being asked in the context of some ;; excessively glueless subquestion. @@ -246,7 +281,7 @@ (match-define (question name type class parent) q) (let search ((ancestor parent)) (match ancestor - [(question _ _ _ ancestor-parent) (search ancestor-parent)] + [(subquestion (question _ _ _ ancestor-parent)) (search ancestor-parent)] ['restart #t] [_ #f]))) @@ -255,3 +290,14 @@ ;; retracing from the roots in cases of excessive gluelessness. (define (restart-question q) (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 ? diff --git a/network-query.rkt b/network-query.rkt index 514d891..1042a63 100644 --- a/network-query.rkt +++ b/network-query.rkt @@ -175,7 +175,7 @@ [remaining-addresses (hash-ref known-addresses current-name)] [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]) (send-message subq) (subscribe/fresh subscription-id diff --git a/proxy.rkt b/proxy.rkt index 278abb0..fcccc62 100644 --- a/proxy.rkt +++ b/proxy.rkt @@ -145,21 +145,6 @@ (unsubscribe wait-id) (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) ;; Restart q, an overly-glueless question, from the roots. (define restarted-question (restart-question q)) @@ -285,7 +270,8 @@ [(partial-answer base cnames) (transition (expanding-cnames q base (length cnames)) (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) (subscribe/fresh subscription-id (message-handlers (expanding-cnames q acc remaining)