Refactor and document network-query/addresses

This commit is contained in:
Tony Garnock-Jones 2011-12-30 13:30:58 -05:00
parent f4a63a0832
commit 4fb9480532
1 changed files with 82 additions and 41 deletions

View File

@ -143,58 +143,99 @@
'() '()
'()))) '())))
(define (incorporate-claims claim-rrset ns-rr zone) ;; incorporate-dns-reply :
(foldl (lambda (claim-rr zone) ;; DNSMessage CompiledZone RR<NS> ( -> Maybe<CompiledZone> )
(if (in-bailiwick? (rr-name claim-rr) ns-rr) ;; -> Maybe<CompiledZone>
(incorporate-rr claim-rr zone) ;;
zone)) ;; Incorporates RRs from the answer, authorities, and additional
zone ;; sections of the passed-in `message` to the passed-in `zone`,
claim-rrset)) ;; returning the augmented zone. RRs are only incorporated if their
;; `rr-name` falls in the bailiwick of the given `ns-rr`. All of this
(define (incorporate-dns-reply m zone ns-rr keep-trying) ;; only happens if the passed-in message's `dns-message-response-code`
(case (dns-message-response-code m) ;; 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) [(no-error)
(foldl (lambda (claim-rr zone) (foldl (lambda (claim-rr zone)
(if (in-bailiwick? (rr-name claim-rr) ns-rr) (if (in-bailiwick? (rr-name claim-rr) ns-rr)
(incorporate-rr claim-rr zone) (incorporate-rr claim-rr zone)
zone)) zone))
zone zone
(append (dns-message-answers m) (append (dns-message-answers message)
(dns-message-authorities m) (dns-message-authorities message)
(dns-message-additional m)))] (dns-message-additional message)))]
[(name-error) #f] [(name-error) #f]
[else (keep-trying)])) [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) (define (network-query/addresses q zone ns-rr server-ips)
(let ((s (udp-open-socket #f #f))) (let ((s (udp-open-socket #f #f)))
;; TODO: randomize ordering of servers in list. (let try-with-timeout ((timeout first-timeout))
(let search ((timeout 3) (match (network-query/addresses/timeout s q zone ns-rr server-ips timeout)
(remaining-ips server-ips)) ['no-answer
(if (null? remaining-ips) (define new-timeout (next-timeout timeout))
(let ((new-timeout (next-timeout timeout))) (if new-timeout
(if new-timeout (try-with-timeout new-timeout)
(search new-timeout server-ips) (negative-network-query-result zone))]
(negative-network-query-result zone))) [result result]))))
(let ((ip (car remaining-ips)))
(define server-host-name (ip->host-name ip)) ;; network-query/addresses/timeout :
(define server-port 53) ;; UdpSocket Question CompiledZone RR<NS> ListOf<IPv4> Seconds
(write `(querying ,server-host-name ,server-port with timeout ,timeout)) (newline) ;; -> (or Maybe<CompiledZone> 'no-answer)
(udp-send-to s server-host-name server-port (make-network-query-packet q)) ;;
(define buffer (make-bytes 512)) ;; maximum DNS reply length ;; Sends the question to each of the servers whose addresses are given
(define result (udp-receive/timeout s buffer timeout)) ;; in `server-ips` using `network-query/address/timeout`, one at a
;; TODO: correlate query-ID ;; time, in order, trying the next in the list only if `'no-answer`
;; TODO: maybe receive only specifically from the queried IP address? ;; results from the most recent communication attempt. If and when the
(if result ;; list is exhausted, `'no-answer` is returned.
(let* ((reply-length (car result)) (define (network-query/addresses/timeout s q zone ns-rr server-ips timeout)
(packet (subbytes buffer 0 reply-length)) ;; TODO: randomize ordering of servers in list.
(reply-message (packet->dns-message packet))) (let search ((remaining-ips server-ips))
(pretty-print `(response ,result ,reply-message)) (if (null? remaining-ips)
(incorporate-dns-reply reply-message 'no-answer
zone (match (network-query/address/timeout s q zone ns-rr (car remaining-ips) timeout)
ns-rr ['no-answer (search (cdr remaining-ips))]
(lambda () [result result]))))
(search timeout (cdr remaining-ips)))))
(search timeout (cdr remaining-ips)))))))) ;; 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 (network-query q zone ns-rr)
(define ns-name (rr-rdata ns-rr)) (define ns-name (rr-rdata ns-rr))