Distinguish between NS and CNAME subquestions.

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<CompleteAnswer>).
 (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 ?

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

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)