Refactor and document network-query/addresses

resolver-unit.rkt

@@ -143,58 +143,99 @@
 		'()
 		'())))
 
-(define (incorporate-claims claim-rrset ns-rr zone)
-  (foldl (lambda (claim-rr zone)
-	   (if (in-bailiwick? (rr-name claim-rr) ns-rr)
-	       (incorporate-rr claim-rr zone)
-	       zone))
-	 zone
-	 claim-rrset))
-
-(define (incorporate-dns-reply m zone ns-rr keep-trying)
-  (case (dns-message-response-code m)
+;; incorporate-dns-reply :
+;;   DNSMessage CompiledZone RR<NS> ( -> Maybe<CompiledZone> )
+;;   -> Maybe<CompiledZone>
+;;
+;; 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
+;; only happens if the passed-in message's `dns-message-response-code`
+;; is `'no-error`: if it's `'name-error`, then `#f` is returned, and
+;; if it's any other code,the `keep-trying` thunk is invoked. (If the
+;; caller is `network-query/addresses`, then `keep-trying` will try
+;; other servers from the list of IPs available.)
+(define (incorporate-dns-reply message zone ns-rr keep-trying)
+  (case (dns-message-response-code message)
     [(no-error) 
      (foldl (lambda (claim-rr zone)
 	      (if (in-bailiwick? (rr-name claim-rr) ns-rr)
 		  (incorporate-rr claim-rr zone)
 		  zone))
 	    zone
-	    (append (dns-message-answers m)
-		    (dns-message-authorities m)
-		    (dns-message-additional m)))]
+	    (append (dns-message-answers message)
+		    (dns-message-authorities message)
+		    (dns-message-additional message)))]
     [(name-error) #f]
     [else (keep-trying)]))
 
+;; network-query/addresses :
+;;   Question CompiledZone RR<NS> ListOf<IPv4> -> Maybe<CompiledZone>
+;;
+;; Repeatedly uses `network-query/addresses/timeout` to try asking the
+;; whole of `server-ips` the question `q`, starting with a timeout of
+;; `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 q zone ns-rr server-ips)
   (let ((s (udp-open-socket #f #f)))
-    ;; TODO: randomize ordering of servers in list.
-    (let search ((timeout 3)
-		 (remaining-ips server-ips))
-      (if (null? remaining-ips)
-	  (let ((new-timeout (next-timeout timeout)))
-	    (if new-timeout
-		(search new-timeout server-ips)
-		(negative-network-query-result zone)))
-	  (let ((ip (car remaining-ips)))
-	    (define server-host-name (ip->host-name ip))
-	    (define server-port 53)
-	    (write `(querying ,server-host-name ,server-port with timeout ,timeout)) (newline)
-	    (udp-send-to s server-host-name server-port (make-network-query-packet q))
-	    (define buffer (make-bytes 512)) ;; maximum DNS reply length
-	    (define result (udp-receive/timeout s buffer timeout))
-	    ;; TODO: correlate query-ID
-	    ;; TODO: maybe receive only specifically from the queried IP address?
-	    (if result
-		(let* ((reply-length (car result))
-		       (packet (subbytes buffer 0 reply-length))
-		       (reply-message (packet->dns-message packet)))
-		  (pretty-print `(response ,result ,reply-message))
-		  (incorporate-dns-reply reply-message
-					 zone
-					 ns-rr
-					 (lambda ()
-					   (search timeout (cdr remaining-ips)))))
-		(search timeout (cdr remaining-ips))))))))
+    (let try-with-timeout ((timeout first-timeout))
+      (match (network-query/addresses/timeout s q zone ns-rr server-ips timeout)
+	['no-answer
+	 (define new-timeout (next-timeout timeout))
+	 (if new-timeout
+	     (try-with-timeout new-timeout)
+	     (negative-network-query-result zone))]
+	[result result]))))
+
+;; network-query/addresses/timeout :
+;;   UdpSocket Question CompiledZone RR<NS> ListOf<IPv4> Seconds
+;;   -> (or Maybe<CompiledZone> 'no-answer)
+;;
+;; Sends the question to each of the servers whose addresses are given
+;; in `server-ips` using `network-query/address/timeout`, one at a
+;; 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)
+  ;; TODO: randomize ordering of servers in list.
+  (let search ((remaining-ips server-ips))
+    (if (null? remaining-ips)
+	'no-answer
+	(match (network-query/address/timeout s q zone ns-rr (car remaining-ips) timeout)
+	  ['no-answer (search (cdr remaining-ips))]
+	  [result result]))))
+
+;; network-query/addresses :
+;;   UdpSocket Question CompiledZone RR<NS> IPv4 Seconds
+;;   -> (or Maybe<CompiledZone> 'no-answer)
+;;
+;; Sends the question to the server address `server-ip` given. Waits
+;; `timeout` seconds for an answer: if one arrives, it is incorporated
+;; into the passed-in `zone` (using `incorporate-dns-reply`), and the
+;; 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)
+  (define server-host-name (ip->host-name server-ip))
+  (define server-port 53)
+  (write `(querying ,server-host-name ,server-port with timeout ,timeout)) (newline)
+  (udp-send-to s server-host-name server-port (make-network-query-packet q))
+  (define buffer (make-bytes 512)) ;; maximum DNS reply length
+  (define result (udp-receive/timeout s buffer timeout))
+  ;; TODO: correlate query-ID
+  ;; TODO: maybe receive only specifically from the queried IP address?
+  (if result
+      (let* ((reply-length (car result))
+	     (packet (subbytes buffer 0 reply-length))
+	     (reply-message (packet->dns-message packet)))
+	(pretty-print `(response ,result ,reply-message))
+	(incorporate-dns-reply reply-message
+			       zone
+			       ns-rr
+			       (lambda () 'no-answer)))
+      'no-answer))
 
 (define (network-query q zone ns-rr)
   (define ns-name (rr-rdata ns-rr))