Try the nameservers we have addresses for before looking up any more nameserver addresses.

driver.rkt

@@ -77,7 +77,7 @@
     (dns-message (dns-message-id request-message)
 		 'response
 		 'query
-		 (if (in-bailiwick? name soa-rr) 'authoritative 'non-authoritative)
+		 (if (in-bailiwick? name (rr-name soa-rr)) 'authoritative 'non-authoritative)
 		 'not-truncated
 		 (dns-message-recursion-desired request-message)
 		 'no-recursion-available

network-query.rkt

@@ -89,21 +89,22 @@
 	       '()))
 
 ;; incorporate-dns-reply :
-;;   DNSMessage CompiledZone RR<NS>
+;;   DNSMessage CompiledZone DomainName
 ;;   -> (or Maybe<CompiledZone> 'no-answer)
 ;;
 ;; Incorporates RRs from the answer, authorities, and additional
 ;; sections of the passed-in `message` to the passed-in `zone`,
 ;; returning the augmented zone. RRs are only incorporated if their
-;; `rr-name` falls in the bailiwick of the given `ns-rr`. All of this
+;; `rr-name` falls in the bailiwick of the given `zone-origin`. All of
-;; only happens if the passed-in message's `dns-message-response-code`
+;; this only happens if the passed-in message's
-;; is `'no-error`: if it's `'name-error`, then `#f` is returned, and
+;; `dns-message-response-code` is `'no-error`: if it's `'name-error`,
-;; if it's any other code, `'no-answer` is returned.
+;; then `#f` is returned, and if it's any other code, `'no-answer` is
-(define (incorporate-dns-reply message zone ns-rr)
+;; returned.
+(define (incorporate-dns-reply message zone zone-origin)
   (case (dns-message-response-code message)
     [(no-error) 
      (foldl (lambda (claim-rr zone)
-	      (if (in-bailiwick? (rr-name claim-rr) ns-rr)
+	      (if (in-bailiwick? (rr-name claim-rr) zone-origin)
 		  (incorporate-rr claim-rr zone)
 		  zone))
 	    zone
@@ -114,7 +115,7 @@
     [else 'no-answer]))
 
 ;; network-query/addresses :
-;;   UdpAddress Question CompiledZone RR<NS> ListOf<IPv4>
+;;   UdpAddress Question CompiledZone DomainName ListOf<IPv4>
 ;;     (Maybe<CompiledZone> -> ListOf<Action>) -> ListOf<Action>
 ;;
 ;; Repeatedly uses `network-query/addresses/timeout` to try asking the
@@ -122,9 +123,9 @@
 ;; `first-timeout` seconds and increasing each time
 ;; `network-query/addresses/timeout` returns `'no-answer` up to a
 ;; give-up timeout limit.
-(define (network-query/addresses s q zone ns-rr server-ips k)
+(define (network-query/addresses s q zone zone-origin server-ips k)
   (let try-with-timeout ((timeout first-timeout))
-    (network-query/addresses/timeout s q zone ns-rr server-ips timeout
+    (network-query/addresses/timeout s q zone zone-origin server-ips timeout
      (lambda (result)
        (if (eq? result 'no-answer)
 	   (let ((new-timeout (next-timeout timeout)))
@@ -134,7 +135,7 @@
 	   (k result))))))
 
 ;; network-query/addresses/timeout :
-;;   UdpAddress Question CompiledZone RR<NS> ListOf<IPv4> Seconds
+;;   UdpAddress Question CompiledZone DomainName ListOf<IPv4> Seconds
 ;;     ((or Maybe<CompiledZone> 'no-answer) -> ListOf<Action>) -> ListOf<Action>
 ;;
 ;; Sends the question to each of the servers whose addresses are given
@@ -142,19 +143,19 @@
 ;; time, in order, trying the next in the list only if `'no-answer`
 ;; results from the most recent communication attempt. If and when the
 ;; list is exhausted, `'no-answer` is returned.
-(define (network-query/addresses/timeout s q zone ns-rr server-ips timeout k)
+(define (network-query/addresses/timeout s q zone zone-origin server-ips timeout k)
   ;; TODO: randomize ordering of servers in list.
   (let search ((remaining-ips server-ips))
     (if (null? remaining-ips)
 	(k 'no-answer)
-	(network-query/address/timeout s q zone ns-rr (car remaining-ips) timeout
+	(network-query/address/timeout s q zone zone-origin (car remaining-ips) timeout
 	 (lambda (result)
 	   (if (eq? result 'no-answer)
 	       (search (cdr remaining-ips))
 	       (k result)))))))
 
 ;; network-query/address/timeout :
-;;   UdpAddress Question CompiledZone RR<NS> IPv4 Seconds
+;;   UdpAddress Question CompiledZone DomainName IPv4 Seconds
 ;;     ((or Maybe<CompiledZone> 'no-answer) -> ListOf<Action>) -> ListOf<Action>
 ;;
 ;; Sends the question to the server address `server-ip` given. Waits
@@ -163,7 +164,7 @@
 ;; result is returned to the caller. If the timeout expires before a
 ;; reply is received, or some error result is received from the
 ;; server, `'no-answer` is returned to the caller.
-(define (network-query/address/timeout s q zone ns-rr server-ip timeout k)
+(define (network-query/address/timeout s q zone zone-origin server-ip timeout k)
   (define server-host-name (ip->host-name server-ip))
   (define server-port 53)
   (define query (make-dns-query-message q))
@@ -174,16 +175,16 @@
   (list (send-message req)
 	(send-message (set-timer subscription-id (* timeout 1000) #t))
 	(subscribe subscription-id
-		   (message-handlers w
+	 (message-handlers w
-		    [(timer-expired (== subscription-id) _)
+	  [(timer-expired (== subscription-id) _)
-		     (write `(Timed out ,q to ,ns-rr after ,timeout seconds)) (newline)
+	   (write `(Timed out ,q to ,zone-origin ,server-ip after ,timeout seconds)) (newline)
-		     (transition w
+	   (transition w
-				 (unsubscribe subscription-id)
+		       (unsubscribe subscription-id)
-				 (k 'no-answer))]
+		       (k 'no-answer))]
-		    [(dns-reply reply-message source (== s))
+	  [(dns-reply reply-message source (== s))
-		     ;; TODO: maybe receive only specifically from the queried IP address?
+	   ;; TODO: maybe receive only specifically from the queried IP address?
-		     (if (not (= (dns-message-id reply-message) (dns-message-id query)))
+	   (if (not (= (dns-message-id reply-message) (dns-message-id query)))
-			 w
+	       w
-			 (transition w
+	       (transition w
-				     (unsubscribe subscription-id)
+			   (unsubscribe subscription-id)
-				     (k (incorporate-dns-reply reply-message zone ns-rr))))]))))
+			   (k (incorporate-dns-reply reply-message zone zone-origin))))]))))

proxy.rkt

@@ -113,9 +113,9 @@
 
   (define (resolver-actions qr)
     (match qr
-      [(resolver-network-query q zone ns-rr addresses k) ;; need subquestion answered
+      [(resolver-network-query q zone zone-origin addresses k) ;; need subquestion answered
        ;;(write `(INTERMEDIATE ,q ,ns-rr (,(length addresses) addresses))) (newline)
-       (network-query/addresses client-sock q zone ns-rr addresses
+       (network-query/addresses client-sock q zone zone-origin addresses
 				(lambda (qr) (resolver-actions (k qr))))]
       [#f ;; got a name-error/NXDOMAIN from some nameserver
        ;; TODO: re-examine my reasoning for not sending name-error/NXDOMAIN here

resolver-test.rkt

@@ -30,9 +30,9 @@
 
 (define (drive-resolver qr)
   (match qr
-    [(resolver-network-query q zone ns-rr addresses k)
+    [(resolver-network-query q zone zone-origin addresses k)
-     (write `(INTERMEDIATE ,q ,ns-rr (,(length addresses) addresses))) (newline)
+     (write `(INTERMEDIATE ,q ,zone-origin (,(length addresses) addresses))) (newline)
-     (network-query/addresses 'foo q zone ns-rr addresses
+     (network-query/addresses 'foo q zone zone-origin addresses
 			      (lambda (qr) (drive-resolver (k qr))))]
     [_ qr]))
 

resolver.rkt

@@ -4,6 +4,7 @@
 
 (require racket/set)
 (require racket/match)
+(require racket/list)
 (require "api.rkt")
 (require "codec.rkt")
 (require "zonedb.rkt")
@@ -19,10 +20,10 @@
 ;; A ResolverContinuation is a (Maybe<CompiledZone> -> ResolverResult).
 
 ;; A ResolverNetworkQuery is a (resolver-network-query Question
-;; CompiledZone RR<NS> ListOf<IPv4> ResolverContinuation),
+;; CompiledZone DomainName ListOf<IPv4> ResolverContinuation),
 ;; representing a subquestion that must be answered before resolution
 ;; can continue.
-(struct resolver-network-query (q zone ns-rr addresses k) #:transparent)
+(struct resolver-network-query (q zone zone-origin addresses k) #:transparent)
 
 ;; Rules:
 ;;
@@ -76,7 +77,7 @@
 				      zone
 				      (set-union cnames filtered-rrs)
 				      (if (and start-of-authority
-					       (in-bailiwick? name start-of-authority))
+					       (in-bailiwick? name (rr-name start-of-authority)))
 					  (set start-of-authority)
 					  (set))
 				      (set)))
@@ -118,28 +119,15 @@
       ;; Remove a label and keep looking.
       (search (cdr name))))))
 
-;; Returns a list of NS RRs in some priority order: records for which
+;; Returns a set of NS RRs in an arbitrary order.
-;; we know the associated A record are listed before records for which
-;; we don't.
 (define (closest-untried-nameservers q zone nameservers-tried)
   (define name (question-name q))
   (define ns-rrset (closest-nameservers name zone))
-  (let loop ((untried (set->list (set-subtract ns-rrset nameservers-tried)))
+  (set-subtract ns-rrset nameservers-tried))
-	     (with-address '())
-	     (without-address '()))
-    (if (null? untried)
-	(append with-address without-address)
-	(let ((ns-rr (car untried)))
-	  (define rrs (hash-ref zone (rr-rdata ns-rr) (set)))
-	  (define a-rrs (filter-by-type rrs 'a))
-	  (define has-address? (not (set-empty? a-rrs)))
-	  (loop (cdr untried)
-		(if has-address? (cons ns-rr with-address) with-address)
-		(if has-address? without-address (cons ns-rr without-address)))))))
 
 (define (empty-answer q zone start-of-authority)
   (if (and start-of-authority
-	   (in-bailiwick? (question-name q) start-of-authority))
+	   (in-bailiwick? (question-name q) (rr-name start-of-authority)))
       ;; NXDOMAIN/name-error if the question is something we're qualified to answer
       #f
       ;; A normal no-answers packet otherwise.
@@ -149,31 +137,43 @@
 		       (set)
 		       (set))))
 
-(define (random-element a-nonempty-list)
+(define (group-rrs-with-known-address ns-set zone)
-  (car a-nonempty-list))
+  (partition (lambda (rr)
+	       (not (set-empty? (filter-by-type (hash-ref zone (rr-rdata rr) set) 'a))))
+	     (set->list ns-set)))
 
-(define (network-query q zone ns-rr k)
+(define (resolve-nameservers ns-set zone k)
-  (define ns-name (rr-rdata ns-rr))
+  (define-values (addressable-rrs non-addressable-rrs) (group-rrs-with-known-address ns-set zone))
-  ;; ^ the rr-name is the subzone origin; the rr-rdata is the
+  (define resort-to-recursion? (null? addressable-rrs))
-  ;; nameserver for the subzone
+  ;; ^ only recurse if we know absolutely *none* of the addresses of
-  (resolve-from-zone
+  ;; the nameservers we've been asked to resolve.
-   (question ns-name 'a 'in) ;; TODO: 'aaaa ?
+  (define chosen-ns-rrs (if (null? addressable-rrs) non-addressable-rrs addressable-rrs))
-   zone
+  (define zone-origin (rr-name (car chosen-ns-rrs)))
-   #f
+  ;; ^ Bailiwick of the nameservers. Any element of ns-set will do,
-   #t
+  ;; since they all have the same rr-name by operation of
-   (set)
+  ;; closest-untried-nameservers.
-   (lambda (qr)
+  (let loop ((nss chosen-ns-rrs)
-     (match qr
+	     (nameserver-ips (set))
-       [#f (k zone)] ;; Can't find the address of the nameserver!
+	     (zone zone))
-       [(question-result _ enhanced-zone answers _ _)
+    (if (null? nss)
-	(define address-rrs (filter-by-type answers 'a))
+	(k (map rr-rdata (set->list nameserver-ips)) zone zone-origin (list->set chosen-ns-rrs))
-	(if (set-empty? address-rrs)
+	(let ((ns-rr (car nss)))
-	    (k zone) ;; Again, no addresses for the nameserver!
+	  (define ns-name (rr-rdata ns-rr)) ;; name of this server
-	    (resolver-network-query q
+	  (define (accumulate-ips ips zone) (loop (cdr nss) (set-union ips nameserver-ips) zone))
-				    enhanced-zone
+	  ;;(write `(loop ,resort-to-recursion? ,ns-name ,zone-origin ,(length nss) ,(set-count nameserver-ips))) (newline)
-				    ns-rr
+	  (resolve-from-zone (question ns-name 'a 'in) ;; TODO: 'aaaa ?
-				    (map rr-rdata (set->list address-rrs))
+			     zone
-				    k))]))))
+			     #f ;; we are not ourselves authoritative in this context
+			     resort-to-recursion?
+			     (set)
+			     (lambda (qr)
+			       (match qr
+				 [#f
+				  ;; Got an NXDOMAIN while searching for the nameserver's address.
+				  (accumulate-ips (set) zone)]
+				 [(question-result _ enhanced-zone answers _ _)
+				  ;; Got a (possibly-empty) set of answers.
+				  (accumulate-ips (filter-by-type answers 'a) enhanced-zone)])))))))
 
 ;; additional-section/a : CompiledZone ListOf<DomainName>
 ;; Implements the "additional section" rules from RFC 1035 (and the
@@ -186,7 +186,7 @@
 	   (set-union section
 		      (set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa))
 						    (eqv? (rr-class rr) 'in)))
-				  (hash-ref zone name))))
+				  (hash-ref zone name set))))
 	 (set)
 	 names))
 
@@ -207,20 +207,21 @@
    k
    (lambda ()
      (let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
-       (if (null? best-nameservers)
+       (if (set-empty? best-nameservers)
 	   (k (empty-answer q zone start-of-authority))
 	   (if recursion-desired?
-	       (let ((best-nameserver (random-element best-nameservers)))
+	       (resolve-nameservers best-nameservers zone
-		 (network-query q zone best-nameserver
+		(lambda (nameserver-ips zone zone-origin chosen-nameservers)
-				(lambda (enhanced-zone)
+		  (resolver-network-query q zone zone-origin nameserver-ips
-				  (if (eq? enhanced-zone #f)
+		   (lambda (enhanced-zone)
-				      ;; name-error received!
+		     (if (eq? enhanced-zone #f)
-				      (k #f)
+			 ;; name-error received!
-				      ;; we presumably learned something that might help us
+			 (k #f)
-				      (resolve-from-zone q
+			 ;; we presumably learned something that might help us
-							 enhanced-zone
+			 (resolve-from-zone q
-							 start-of-authority
+					    enhanced-zone
-							 recursion-desired?
+					    start-of-authority
-							 (set-add nameservers-tried best-nameserver)
+					    recursion-desired?
-							 k)))))
+					    (set-union nameservers-tried chosen-nameservers)
-	       (k (build-referral q zone start-of-authority (list->set best-nameservers)))))))))
+					    k))))))
+	       (k (build-referral q zone start-of-authority best-nameservers))))))))

simplified-driver.rkt

@@ -92,7 +92,7 @@
     (dns-message (dns-message-id request-message)
 		 'response
 		 'query
-		 (if (in-bailiwick? name soa-rr) 'authoritative 'non-authoritative)
+		 (if (in-bailiwick? name (rr-name soa-rr)) 'authoritative 'non-authoritative)
 		 'not-truncated
 		 (dns-message-recursion-desired request-message)
 		 'no-recursion-available

zonedb.rkt

@@ -36,14 +36,14 @@
 (define (compiled-zone? z)
   (hash? z)) ;; hm
 
-;; in-bailiwick? : DomainName RR -> Boolean
+;; in-bailiwick? : DomainName DomainName -> Boolean
 ;; Answers #t iff dn falls within the bailiwick of the zone with
-;; origin rr.
+;; origin o.
-(define (in-bailiwick? dn rr)
+(define (in-bailiwick? dn o)
   (cond
-   ((equal? dn (rr-name rr)) #t)
+   ((equal? dn o) #t)
    ((null? dn) #f)
-   (else (in-bailiwick? (cdr dn) rr))))
+   (else (in-bailiwick? (cdr dn) o))))
 
 ;; set-filter : (X -> Boolean) SetOf<X> -> SetOf<X>
 ;; Retains only those elements of its argument for which the predicate