From 3822cad5236e4f35aae3abb378198610a08acd3c Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 4 Apr 2013 11:53:36 -0400 Subject: [PATCH] Use net/private/ip in net/dns This simplifies the code by outsourcing IP address functionality to net/private/ip. original commit: 92102a2f07ec859bfd562eb6a481b1778dd5d7db --- collects/net/dns.rkt | 228 +++++++++++-------------------------------- 1 file changed, 59 insertions(+), 169 deletions(-) diff --git a/collects/net/dns.rkt b/collects/net/dns.rkt index 5d4727a1a4..1bb6a12bf0 100644 --- a/collects/net/dns.rkt +++ b/collects/net/dns.rkt @@ -2,7 +2,8 @@ ;; DNS query library for Racket -(require racket/bool +(require "private/ip.rkt" + racket/bool racket/contract racket/format racket/list @@ -14,13 +15,17 @@ (provide (contract-out [dns-get-address - (->* (ip-address-string? string?) + (->* ((or/c ip-address? ip-address-string?) string?) (#:ipv6? any/c) ip-address-string?)] [dns-get-name - (-> ip-address-string? ip-address-string? string?)] + (-> (or/c ip-address? ip-address-string?) + (or/c ip-address? ip-address-string?) + string?)] [dns-get-mail-exchanger - (-> ip-address-string? string? (or/c bytes? string?))] + (-> (or/c ip-address? ip-address-string?) + string? + (or/c bytes? string?))] [dns-find-nameserver (-> (or/c ip-address-string? #f))])) @@ -29,95 +34,8 @@ ;; UDP retry timeout: (define INIT-TIMEOUT 50) -;; Contract utilities and Data Definitions -;; +;; Data Definitions ;; An LB is a (Listof Bytes) -;; -;; An IPAddressString passes the following predicate -(define (ip-address-string? val) - (and (string? val) - (or (ipv4-string? val) - (ipv6-string? val)))) - -;; String -> Boolean -;; Check if the input string represents an IPv4 address -(define (ipv4-string? str) - ;; String -> Boolean - ;; check if the given string has leading zeroes - (define (has-leading-zeroes? str) - (and (> (string-length str) 1) - (char=? (string-ref str 0) #\0))) - (define matches - (regexp-match #px"^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$" - str)) - (and matches - (= (length matches) 5) - ;; check that each octet field is an octet - (andmap byte? (map string->number (cdr matches))) - ;; leading zeroes lead to query errors - (not (ormap has-leading-zeroes? matches)))) - -;; String -> Boolean -;; Check if the input string represents an IPv6 address -;; TODO: support dotted quad notation -(define (ipv6-string? str) - (define re-::/: #px"^([0-9a-fA-F]{1,4})(::|:)") - (define re-:: #px"^()(::)") - (define re-: #px"^([0-9a-fA-F]{1,4})(:)") - (define re-end #px"^[0-9a-fA-F]{1,4}$") - (or (regexp-match? #px"^::$" str) ; special case - (let loop ([octet-pairs '()] ; keep octet-pairs to count - [::? #f] ; seen a :: in the string yet? - [str str]) - ;; match digit groups and a separator - (define matches - (if ::? - (regexp-match re-: str) - (or (regexp-match re-:: str) - (regexp-match re-::/: str)))) - (cond [matches - (match-define (list match digits sep) matches) - (define rest (substring str (string-length match))) - ;; we need to make sure there is only one :: at most - (if (or ::? (string=? sep "::")) - (loop (cons digits octet-pairs) #t rest) - (loop (cons digits octet-pairs) #f rest))] - [else - (and ;; if there isn't a ::, we need 7+1 octet-pairs - (implies (not ::?) (= (length octet-pairs) 7)) - ;; this is the +1 octet pair - (regexp-match? re-end str))])))) - -(module+ test - (check-true (ip-address-string? "8.8.8.8")) - (check-true (ip-address-string? "12.81.255.109")) - (check-true (ip-address-string? "192.168.0.1")) - (check-true (ip-address-string? "2001:0db8:85a3:0000:0000:8a2e:0370:7334")) - (check-true (ip-address-string? "2001:200:dff:fff1:216:3eff:feb1:44d7")) - (check-true (ip-address-string? "2001:db8:85a3:0:0:8a2e:370:7334")) - (check-true (ip-address-string? "2001:db8:85a3::8a2e:370:7334")) - (check-true (ip-address-string? "0:0:0:0:0:0:0:1")) - (check-true (ip-address-string? "0:0:0:0:0:0:0:0")) - (check-true (ip-address-string? "::")) - (check-true (ip-address-string? "::0")) - (check-true (ip-address-string? "::ffff:c000:0280")) - (check-true (ip-address-string? "2001:db8::2:1")) - (check-true (ip-address-string? "2001:db8:0:0:1::1")) - (check-false (ip-address-string? "")) - (check-false (ip-address-string? ":::")) - (check-false (ip-address-string? "::0::")) - (check-false (ip-address-string? "2001::db8::2:1")) - (check-false (ip-address-string? "2001:::db8:2:1")) - (check-false (ip-address-string? "52001:db8::2:1")) - (check-false (ip-address-string? "80.8.800.8")) - (check-false (ip-address-string? "80.8.800.0")) - (check-false (ip-address-string? "080.8.800.8")) - (check-false (ip-address-string? "vas8.8.800.8")) - (check-false (ip-address-string? "80.8.128.8dd")) - (check-false (ip-address-string? "0.8.800.008")) - (check-false (ip-address-string? "0.8.800.a8")) - (check-false (ip-address-string? "potatoes")) - (check-false (ip-address-string? "127.0.0"))) ;; A Type is one of the following (define types @@ -280,12 +198,14 @@ (loop (sub1 n) start (cons rr accum)))))) ;; NameServer String Type Class -> (Values Boolean LB LB LB LB LB) -(define (dns-query nameserver addr type class) +(define (dns-query nameserver-ip addr type class) (unless (assoc type types) (raise-type-error 'dns-query "DNS query type" type)) (unless (assoc class classes) (raise-type-error 'dns-query "DNS query class" class)) + (define nameserver (ip-address->string nameserver-ip)) + (let* ([query (make-query (random 256) (string->bytes/latin-1 addr) type class)] [udp (udp-open-socket nameserver 53)] @@ -345,51 +265,22 @@ ;; NameServer Address Type Class -> (Values Boolean LB LB LB LB LB) ;; Execute a DNS query and cache it (define (dns-query/cache nameserver addr type class) - (let ([key (string->symbol (format "~a;~a;~a;~a" nameserver addr type class))]) - (let ([v (hash-ref cache key (lambda () #f))]) - (if v - (apply values v) - (let-values ([(auth? qds ans nss ars reply) - (dns-query nameserver addr type class)]) - (hash-set! cache key (list auth? qds ans nss ars reply)) - (values auth? qds ans nss ars reply)))))) + (define key (string->symbol (format "~a;~a;~a;~a" nameserver addr type class))) + (define v (hash-ref cache key (lambda () #f))) + (if v + (apply values v) + (let-values ([(auth? qds ans nss ars reply) + (dns-query nameserver addr type class)]) + (hash-set! cache key (list auth? qds ans nss ars reply)) + (values auth? qds ans nss ars reply)))) -(define (ip->string s) - (format "~a.~a.~a.~a" - (list-ref s 0) (list-ref s 1) (list-ref s 2) (list-ref s 3))) +;; Convert a list of bytes representing an IPv4 address to a string +(define (ip->string lob) + (ip-address->string (ipv4 (list->bytes lob)))) ;; Convert a list of bytes representing an IPv6 address to a string (define (ipv6->string lob) - (define two-octets - (for/list ([oct-pair (in-slice 2 (in-list lob))]) - (define oct1 (car oct-pair)) - (define oct2 (cadr oct-pair)) - (+ (arithmetic-shift oct1 8) oct2))) - (define compressed (compress two-octets)) - (define compressed-strs - (for/list ([elem compressed]) - (if (eq? elem '::) - "" ; string-join will turn this into :: - (~r elem #:base 16)))) - (string-join compressed-strs ":")) - -;; (Listof Number) -> (Listof (U Number '::)) -;; Compress an IPv6 address to its shortest representation -(define (compress lon) - (let loop ([acc '()] [lon lon]) - (cond [(empty? lon) (reverse acc)] - [else - (define zeroes (for/list ([n lon] #:break (not (zero? n))) n)) - (define num-zs (length zeroes)) - (if (<= num-zs 1) - (loop (cons (car lon) acc) (cdr lon)) - (append (reverse acc) '(::) (drop lon num-zs)))]))) - -(module+ test - (check-equal? (compress '(0 0 0 5 5)) '(:: 5 5)) - (check-equal? (compress '(0 5 5)) '(0 5 5)) - (check-equal? (compress '(0 0 5 0 0 5)) '(:: 5 0 0 5)) - (check-equal? (compress '(0 5 0 0 0 5)) '(0 5 :: 5))) + (ip-address->string (ipv6 (list->bytes lob)))) ;; (NameServer -> (Values Any LB Boolean)) NameServer -> Any ;; Run the given query function, trying until an answer is found @@ -407,48 +298,34 @@ (not (member ns tried)) (loop ns (cons ns tried))))))))) -;; String -> String +;; IPAddress -> String ;; Convert an IP address to a suitable format for a reverse lookup (define (ip->query-domain ip) - (if (ipv4-string? ip) + (if (ipv4? ip) (ip->in-addr.arpa ip) (ip->ip6.arpa ip))) ;; Convert an IPv4 address for reverse lookup (define (ip->in-addr.arpa ip) - (let ([result (regexp-match #rx"^([0-9]+)\\.([0-9]+)\\.([0-9]+)\\.([0-9]+)$" - ip)]) - (format "~a.~a.~a.~a.in-addr.arpa" - (list-ref result 4) - (list-ref result 3) - (list-ref result 2) - (list-ref result 1)))) + (define bytes (ipv4-bytes ip)) + (format "~a.~a.~a.~a.in-addr.arpa" + (bytes-ref bytes 3) (bytes-ref bytes 2) + (bytes-ref bytes 1) (bytes-ref bytes 0))) + +(module+ test + (check-equal? (ip->in-addr.arpa (ipv4 (bytes 8 8 8 8))) + "8.8.8.8.in-addr.arpa") + (check-equal? (ip->in-addr.arpa (ipv4 (bytes 127 0 0 1))) + "1.0.0.127.in-addr.arpa")) ;; Convert an IPv6 address for reverse lookup (define (ip->ip6.arpa ip) - (define has-::? (regexp-match? #rx"::" ip)) - (define octet-pair-strings - (cond [has-::? - (define without-:: (regexp-replace #rx"::" ip ":replace-me:")) - (define pieces (regexp-split #rx":" without-::)) - (define num-pieces (sub1 (length pieces))) ; don't count replace-me - (flatten - ;; put in as many 0s needed to expand the :: - (for/list ([piece pieces]) - (if (string=? piece "replace-me") - (build-list (- 8 num-pieces) (λ _ "0")) - piece)))] - [else (regexp-split #rx":" ip)])) - ;; convert to nibbles (define nibbles (for/fold ([nibbles '()]) - ([two-octs octet-pair-strings]) - (define n (string->number two-octs 16)) - (define nib1 (arithmetic-shift (bitwise-and #xf000 n) -12)) - (define nib2 (arithmetic-shift (bitwise-and #x0f00 n) -8)) - (define nib3 (arithmetic-shift (bitwise-and #x00f0 n) -4)) - (define nib4 (bitwise-and #x000f n)) - (append (list nib4 nib3 nib2 nib1) nibbles))) + ([byte (ipv6-bytes ip)]) + (define nib1 (arithmetic-shift (bitwise-and #xf0 byte) -4)) + (define nib2 (bitwise-and #x0f byte)) + (append (list nib2 nib1) nibbles))) (string-append (string-join (for/list ([n nibbles]) (~r n #:base 16)) @@ -457,16 +334,23 @@ (module+ test (check-equal? - (ip->ip6.arpa "4321:0:1:2:3:4:567:89ab") + (ip->ip6.arpa (make-ip-address "4321:0:1:2:3:4:567:89ab")) "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa") (check-equal? - (ip->ip6.arpa "2001:db8::567:89ab") + (ip->ip6.arpa (make-ip-address "2001:db8::567:89ab")) "b.a.9.8.7.6.5.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa")) (define (get-ptr-list-from-ans ans) (filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans)) -(define (dns-get-name nameserver ip) +(define (dns-get-name nameserver-ip-or-string ip-or-string) + (define nameserver (if (ip-address? nameserver-ip-or-string) + nameserver-ip-or-string + (make-ip-address nameserver-ip-or-string))) + (define ip (if (ip-address? ip-or-string) + ip-or-string + (make-ip-address ip-or-string))) + (or (try-forwarding (lambda (nameserver) (let-values ([(auth? qds ans nss ars reply) @@ -485,7 +369,10 @@ #:when (eq? (list-ref ans-entry 1) type)) ans-entry)) -(define (dns-get-address nameserver addr #:ipv6? [ipv6? #f]) +(define (dns-get-address nameserver-ip-or-string addr #:ipv6? [ipv6? #f]) + (define nameserver (if (ip-address? nameserver-ip-or-string) + nameserver-ip-or-string + (make-ip-address nameserver-ip-or-string))) (define type (if ipv6? 'aaaa 'a)) (define (get-address nameserver) (define-values (auth? qds ans nss ars reply) @@ -501,7 +388,10 @@ (or (try-forwarding get-address nameserver) (error 'dns-get-address "bad address"))) -(define (dns-get-mail-exchanger nameserver addr) +(define (dns-get-mail-exchanger nameserver-ip-or-string addr) + (define nameserver (if (ip-address? nameserver-ip-or-string) + nameserver-ip-or-string + (make-ip-address nameserver-ip-or-string))) (or (try-forwarding (lambda (nameserver) (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'mx 'in)])