diff --git a/network-query-sig.rkt b/network-query-sig.rkt new file mode 100644 index 0000000..554f51b --- /dev/null +++ b/network-query-sig.rkt @@ -0,0 +1,3 @@ +#lang racket/signature + +network-query/addresses ;; Question CompiledZone NS-RR ListOf -> Maybe diff --git a/network-query-unit.rkt b/network-query-unit.rkt new file mode 100644 index 0000000..656e5e3 --- /dev/null +++ b/network-query-unit.rkt @@ -0,0 +1,137 @@ +#lang racket/unit + +(require racket/pretty) + +(require racket/match) +(require "api.rkt") +(require "codec.rkt") +(require "zonedb.rkt") +(require "udp-operations-sig.rkt") +(require "network-query-sig.rkt") + +(import udp-operations^) +(export network-query^) + +(define first-timeout 3) ;; seconds + +;; seconds -> Maybe +(define (next-timeout timeout) + (case timeout + ((3) 11) + ((11) 45) + ((45) #f))) + +;; IPv4 -> String +(define (ip->host-name ip-address) + (match-define (vector a b c d) ip-address) + (format "~a.~a.~a.~a" a b c d)) + +(define (make-network-query-packet q) + (dns-message->packet + (dns-message (random 65536) + 'request + 'query + 'non-authoritative + 'not-truncated + 'no-recursion-desired + 'no-recursion-available + 'no-error + (list q) + '() + '() + '()))) + +;; 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 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))) + (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) + 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/address/timeout : +;; 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)) + diff --git a/resolver-sig.rkt b/resolver-sig.rkt index 3e163fa..4cf449f 100644 --- a/resolver-sig.rkt +++ b/resolver-sig.rkt @@ -1,4 +1,3 @@ #lang racket/signature -network-query ;; Question CompiledZone NS-RR -> CompiledZone resolve-from-zone ;; Question CompiledZone SOA-RR Boolean Set -> QuestionResult diff --git a/resolver-test.rkt b/resolver-test.rkt index f036c77..2bff30d 100644 --- a/resolver-test.rkt +++ b/resolver-test.rkt @@ -10,9 +10,11 @@ (require "codec.rkt") (require "zonedb.rkt") (require "ground-udp-operations-unit.rkt") +(require "network-query-unit.rkt") (require "resolver-unit.rkt") -(define-values/invoke-unit/infer (link resolver@ ground-udp-operations@)) +(define-values/invoke-unit/infer + (link resolver@ network-query@ ground-udp-operations@)) ;; (require racket/trace) ;; (trace ;;resolve-from-zone diff --git a/resolver-unit.rkt b/resolver-unit.rkt index e17f402..ddd42c2 100644 --- a/resolver-unit.rkt +++ b/resolver-unit.rkt @@ -7,10 +7,10 @@ (require "api.rkt") (require "codec.rkt") (require "zonedb.rkt") -(require "udp-operations-sig.rkt") +(require "network-query-sig.rkt") (require "resolver-sig.rkt") -(import udp-operations^) +(import network-query^) (export resolver^) (define (answer-available? q zone) @@ -111,132 +111,6 @@ (define (random-element a-nonempty-list) (car a-nonempty-list)) -(define first-timeout 3) ;; seconds - -;; seconds -> Maybe -(define (next-timeout timeout) - (case timeout - ((3) 11) - ((11) 45) - ((45) #f))) - -;; IPv4 -> String -(define (ip->host-name ip-address) - (match-define (vector a b c d) ip-address) - (format "~a.~a.~a.~a" a b c d)) - -(define (negative-network-query-result zone) - zone) - -(define (make-network-query-packet q) - (dns-message->packet - (dns-message (random 65536) - 'request - 'query - 'non-authoritative - 'not-truncated - 'no-recursion-desired - 'no-recursion-available - 'no-error - (list q) - '() - '() - '()))) - -;; 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 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))) - (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/address/timeout : -;; 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)) ;; ^ the rr-name is the subzone origin; the rr-rdata is the @@ -246,11 +120,11 @@ #f #t (set)) - [#f (negative-network-query-result zone)] ;; Can't find the address of the nameserver! + [#f zone] ;; Can't find the address of the nameserver! [(question-result _ enhanced-zone answers _ _) (define address-rrs (filter-by-type answers 'a)) (if (set-empty? address-rrs) - (negative-network-query-result zone) ;; Again, no addresses for the nameserver! + zone ;; Again, no addresses for the nameserver! (network-query/addresses q enhanced-zone ns-rr diff --git a/simplified-driver.rkt b/simplified-driver.rkt index 838f914..10bb659 100644 --- a/simplified-driver.rkt +++ b/simplified-driver.rkt @@ -11,11 +11,13 @@ (require "codec.rkt") (require "zonedb.rkt") (require "ground-udp-operations-unit.rkt") +(require "network-query-unit.rkt") (require "resolver-unit.rkt") (require "dump-bytes.rkt") (require "simple-udp-service.rkt") -(define-values/invoke-unit/infer (link resolver@ ground-udp-operations@)) +(define-values/invoke-unit/infer + (link resolver@ network-query@ ground-udp-operations@)) ;; Instantiated with a SOA record for the zone it is serving as well ;; as a zone's worth of DNS data which is used to answer queries