From 4fb94805320e212ac22cf353e3299838050f3c6f Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 30 Dec 2011 13:30:58 -0500 Subject: [PATCH] Refactor and document network-query/addresses --- resolver-unit.rkt | 123 ++++++++++++++++++++++++++++++---------------- 1 file changed, 82 insertions(+), 41 deletions(-) diff --git a/resolver-unit.rkt b/resolver-unit.rkt index df56c0c..1f8875b 100644 --- a/resolver-unit.rkt +++ b/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 ( -> Maybe ) +;; -> Maybe +;; +;; 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 ListOf -> Maybe +;; +;; 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 ListOf Seconds +;; -> (or Maybe '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 IPv4 Seconds +;; -> (or Maybe '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))