Misc improvements to net/dns' and net/private/ip'.
* Some racketisms.
* Use explicit `in-list' etc in for loops.
* Remove some redundant requires from `net/dns'.
* Move all tests to `tests/net', including a new `tests/net/ip'. In the
future there's a plan to have things like stripped zos etc for
distribution, but we're not there yet, and the net collection is
already organized nicely so this also makes it more uniform.
* Include the dns tests in the main test file.
original commit: 6149134011
This commit is contained in:
Eli Barzilay
parent
518051a4b3
commit
92358cb553
|
|
@ -3,15 +3,11 @@
|
|||
;; DNS query library for Racket
|
||||
|
||||
(require "private/ip.rkt"
|
||||
racket/bool
|
||||
racket/contract
|
||||
racket/format
|
||||
racket/list
|
||||
racket/match
|
||||
racket/string
|
||||
racket/system
|
||||
racket/udp
|
||||
(only-in unstable/sequence in-slice))
|
||||
racket/udp)
|
||||
|
||||
(provide (contract-out
|
||||
[dns-get-address
|
||||
|
|
@ -29,8 +25,6 @@
|
|||
[dns-find-nameserver
|
||||
(-> (or/c ip-address-string? #f))]))
|
||||
|
||||
(module+ test (require rackunit))
|
||||
|
||||
;; UDP retry timeout:
|
||||
(define INIT-TIMEOUT 50)
|
||||
|
||||
|
|
@ -39,23 +33,23 @@
|
|||
|
||||
;; A Type is one of the following
|
||||
(define types
|
||||
'((a 1)
|
||||
(ns 2)
|
||||
(md 3)
|
||||
(mf 4)
|
||||
(cname 5)
|
||||
(soa 6)
|
||||
(mb 7)
|
||||
(mg 8)
|
||||
(mr 9)
|
||||
(null 10)
|
||||
(wks 11)
|
||||
(ptr 12)
|
||||
'((a 1)
|
||||
(ns 2)
|
||||
(md 3)
|
||||
(mf 4)
|
||||
(cname 5)
|
||||
(soa 6)
|
||||
(mb 7)
|
||||
(mg 8)
|
||||
(mr 9)
|
||||
(null 10)
|
||||
(wks 11)
|
||||
(ptr 12)
|
||||
(hinfo 13)
|
||||
(minfo 14)
|
||||
(mx 15)
|
||||
(txt 16)
|
||||
(aaaa 28)))
|
||||
(mx 15)
|
||||
(txt 16)
|
||||
(aaaa 28)))
|
||||
|
||||
;; A Class is one of the following
|
||||
(define classes
|
||||
|
|
@ -67,9 +61,9 @@
|
|||
;;;
|
||||
|
||||
(define (cossa i l)
|
||||
(cond [(null? l) #f]
|
||||
(cond [(null? l) #f]
|
||||
[(equal? (cadar l) i) (car l)]
|
||||
[else (cossa i (cdr l))]))
|
||||
[else (cossa i (cdr l))]))
|
||||
|
||||
(define (number->octet-pair n)
|
||||
(list (arithmetic-shift n -8)
|
||||
|
|
@ -88,13 +82,13 @@
|
|||
;; Convert the domain name into a sequence of labels, where each
|
||||
;; label is a length octet and then that many octets
|
||||
(define (name->octets s)
|
||||
(let ([do-one (lambda (s) (cons (bytes-length s) (bytes->list s)))])
|
||||
(let loop ([s s])
|
||||
(let ([m (regexp-match #rx#"^([^.]*)[.](.*)" s)])
|
||||
(if m
|
||||
(append (do-one (cadr m)) (loop (caddr m)))
|
||||
;; terminate with zero length octet
|
||||
(append (do-one s) (list 0)))))))
|
||||
(define (do-one s) (cons (bytes-length s) (bytes->list s)))
|
||||
(let loop ([s s])
|
||||
(define m (regexp-match #rx#"^([^.]*)[.](.*)" s))
|
||||
(if m
|
||||
(append (do-one (cadr m)) (loop (caddr m)))
|
||||
;; terminate with zero length octet
|
||||
(append (do-one s) (list 0)))))
|
||||
|
||||
;; The query header. See RFC1035 4.1.1 for details
|
||||
;;
|
||||
|
|
@ -134,27 +128,26 @@
|
|||
(car rr))
|
||||
|
||||
(define (parse-name start reply)
|
||||
(let ([v (car start)])
|
||||
(cond
|
||||
[(zero? v)
|
||||
;; End of name
|
||||
(values #f (cdr start))]
|
||||
[(zero? (bitwise-and #xc0 v))
|
||||
;; Normal label
|
||||
(let loop ([len v][start (cdr start)][accum null])
|
||||
(if (zero? len)
|
||||
(let-values ([(s start) (parse-name start reply)])
|
||||
(let ([s0 (list->bytes (reverse accum))])
|
||||
(values (if s (bytes-append s0 #"." s) s0)
|
||||
start)))
|
||||
(loop (sub1 len) (cdr start) (cons (car start) accum))))]
|
||||
[else
|
||||
;; Compression offset
|
||||
(let ([offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
|
||||
(cadr start))])
|
||||
(let-values ([(s ignore-start)
|
||||
(parse-name (list-tail reply offset) reply)])
|
||||
(values s (cddr start))))])))
|
||||
(define v (car start))
|
||||
(cond
|
||||
[(zero? v)
|
||||
;; End of name
|
||||
(values #f (cdr start))]
|
||||
[(zero? (bitwise-and #xc0 v))
|
||||
;; Normal label
|
||||
(let loop ([len v] [start (cdr start)] [accum null])
|
||||
(if (zero? len)
|
||||
(let-values ([(s start) (parse-name start reply)])
|
||||
(define s0 (list->bytes (reverse accum)))
|
||||
(values (if s (bytes-append s0 #"." s) s0)
|
||||
start))
|
||||
(loop (sub1 len) (cdr start) (cons (car start) accum))))]
|
||||
[else
|
||||
;; Compression offset
|
||||
(define offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
|
||||
(cadr start)))
|
||||
(define-values [s ignore-start] (parse-name (list-tail reply offset) reply))
|
||||
(values s (cddr start))]))
|
||||
|
||||
(define (parse-rr start reply)
|
||||
(let-values ([(name start) (parse-name start reply)])
|
||||
|
|
@ -191,7 +184,7 @@
|
|||
(values (list name type class) start))))
|
||||
|
||||
(define (parse-n parse start reply n)
|
||||
(let loop ([n n][start start][accum null])
|
||||
(let loop ([n n] [start start] [accum null])
|
||||
(if (zero? n)
|
||||
(values (reverse accum) start)
|
||||
(let-values ([(rr start) (parse start reply)])
|
||||
|
|
@ -205,58 +198,51 @@
|
|||
(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)]
|
||||
[reply
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(let ([s (make-bytes 512)])
|
||||
(let retry ([timeout INIT-TIMEOUT])
|
||||
(udp-send-to udp nameserver 53 (list->bytes query))
|
||||
(sync (handle-evt (udp-receive!-evt udp s)
|
||||
(lambda (r)
|
||||
(bytes->list (subbytes s 0 (car r)))))
|
||||
(handle-evt (alarm-evt (+ (current-inexact-milliseconds)
|
||||
timeout))
|
||||
(lambda (v)
|
||||
(retry (* timeout 2))))))))
|
||||
(lambda () (udp-close udp)))])
|
||||
|
||||
;; First two bytes must match sent message id:
|
||||
(unless (and (= (car reply) (car query))
|
||||
(= (cadr reply) (cadr query)))
|
||||
(error 'dns-query "bad reply id from server"))
|
||||
|
||||
(let ([v0 (caddr reply)]
|
||||
[v1 (cadddr reply)])
|
||||
;; Check for error code:
|
||||
(let ([rcode (bitwise-and #xf v1)])
|
||||
(unless (zero? rcode)
|
||||
(error 'dns-query "error from server: ~a"
|
||||
(case rcode
|
||||
[(1) "format error"]
|
||||
[(2) "server failure"]
|
||||
[(3) "name error"]
|
||||
[(4) "not implemented"]
|
||||
[(5) "refused"]))))
|
||||
|
||||
(let ([qd-count (octet-pair->number (list-ref reply 4) (list-ref reply 5))]
|
||||
[an-count (octet-pair->number (list-ref reply 6) (list-ref reply 7))]
|
||||
[ns-count (octet-pair->number (list-ref reply 8) (list-ref reply 9))]
|
||||
[ar-count (octet-pair->number (list-ref reply 10) (list-ref reply 11))])
|
||||
|
||||
(let ([start (list-tail reply 12)])
|
||||
(let*-values ([(qds start) (parse-n parse-ques start reply qd-count)]
|
||||
[(ans start) (parse-n parse-rr start reply an-count)]
|
||||
[(nss start) (parse-n parse-rr start reply ns-count)]
|
||||
[(ars start) (parse-n parse-rr start reply ar-count)])
|
||||
(unless (null? start)
|
||||
(error 'dns-query "error parsing server reply"))
|
||||
(values (positive? (bitwise-and #x4 v0))
|
||||
qds ans nss ars reply)))))))
|
||||
(define query (make-query (random 256) (string->bytes/latin-1 addr)
|
||||
type class))
|
||||
(define udp (udp-open-socket nameserver 53))
|
||||
(define reply
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(define s (make-bytes 512))
|
||||
(let retry ([timeout INIT-TIMEOUT])
|
||||
(udp-send-to udp nameserver 53 (list->bytes query))
|
||||
(sync (handle-evt (udp-receive!-evt udp s)
|
||||
(lambda (r) (bytes->list (subbytes s 0 (car r)))))
|
||||
(handle-evt (alarm-evt (+ (current-inexact-milliseconds)
|
||||
timeout))
|
||||
(lambda (v) (retry (* timeout 2)))))))
|
||||
(lambda () (udp-close udp))))
|
||||
;; First two bytes must match sent message id:
|
||||
(unless (and (= (car reply) (car query))
|
||||
(= (cadr reply) (cadr query)))
|
||||
(error 'dns-query "bad reply id from server"))
|
||||
(define v0 (caddr reply))
|
||||
(define v1 (cadddr reply))
|
||||
;; Check for error code:
|
||||
(let ([rcode (bitwise-and #xf v1)])
|
||||
(unless (zero? rcode)
|
||||
(error 'dns-query "error from server: ~a"
|
||||
(case rcode
|
||||
[(1) "format error"]
|
||||
[(2) "server failure"]
|
||||
[(3) "name error"]
|
||||
[(4) "not implemented"]
|
||||
[(5) "refused"]))))
|
||||
(define qd-count (octet-pair->number (list-ref reply 4) (list-ref reply 5)))
|
||||
(define an-count (octet-pair->number (list-ref reply 6) (list-ref reply 7)))
|
||||
(define ns-count (octet-pair->number (list-ref reply 8) (list-ref reply 9)))
|
||||
(define ar-count (octet-pair->number (list-ref reply 10) (list-ref reply 11)))
|
||||
(define start (list-tail reply 12))
|
||||
(let*-values ([(qds start) (parse-n parse-ques start reply qd-count)]
|
||||
[(ans start) (parse-n parse-rr start reply an-count)]
|
||||
[(nss start) (parse-n parse-rr start reply ns-count)]
|
||||
[(ars start) (parse-n parse-rr start reply ar-count)])
|
||||
(unless (null? start)
|
||||
(error 'dns-query "error parsing server reply"))
|
||||
(values (positive? (bitwise-and #x4 v0))
|
||||
qds ans nss ars reply)))
|
||||
|
||||
;; A cache for DNS query data
|
||||
;; Stores a (List Boolean LB LB LB LB LB)
|
||||
|
|
@ -290,10 +276,10 @@
|
|||
(let-values ([(v ars auth?) (k nameserver)])
|
||||
(or v
|
||||
(and (not auth?)
|
||||
(let* ([ns (ormap (lambda (ar)
|
||||
(and (eq? (rr-type ar) 'a)
|
||||
(ip->string (rr-data ar))))
|
||||
ars)])
|
||||
(let ([ns (ormap (lambda (ar)
|
||||
(and (eq? (rr-type ar) 'a)
|
||||
(ip->string (rr-data ar))))
|
||||
ars)])
|
||||
(and ns
|
||||
(not (member ns tried))
|
||||
(loop ns (cons ns tried)))))))))
|
||||
|
|
@ -307,41 +293,21 @@
|
|||
|
||||
;; Convert an IPv4 address for reverse lookup
|
||||
(define (ip->in-addr.arpa ip)
|
||||
(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"))
|
||||
(apply format "~a.~a.~a.~a.in-addr.arpa"
|
||||
(reverse (bytes->list (ipv4-bytes ip)))))
|
||||
|
||||
;; Convert an IPv6 address for reverse lookup
|
||||
(define (ip->ip6.arpa ip)
|
||||
(define nibbles
|
||||
(for/fold ([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))
|
||||
".")
|
||||
".ip6.arpa"))
|
||||
|
||||
(module+ test
|
||||
(check-equal?
|
||||
(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 (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"))
|
||||
(string-join
|
||||
(for/fold ([nibbles '()])
|
||||
([byte (in-bytes (ipv6-bytes ip))])
|
||||
(define nib1 (arithmetic-shift (bitwise-and #xf0 byte) -4))
|
||||
(define nib2 (bitwise-and #x0f byte))
|
||||
(append (list (~r nib2 #:base 16) (~r nib1 #:base 16)) nibbles))
|
||||
"." #:after-last ".ip6.arpa"))
|
||||
|
||||
(define (get-ptr-list-from-ans ans)
|
||||
(filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans))
|
||||
(filter (λ (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans))
|
||||
|
||||
(define (dns-get-name nameserver-ip-or-string ip-or-string)
|
||||
(define nameserver (if (ip-address? nameserver-ip-or-string)
|
||||
|
|
@ -365,7 +331,7 @@
|
|||
|
||||
;; Get resource records corresponding to the given type
|
||||
(define (get-records-from-ans ans type)
|
||||
(for/list ([ans-entry ans]
|
||||
(for/list ([ans-entry (in-list ans)]
|
||||
#:when (eq? (list-ref ans-entry 1) type))
|
||||
ans-entry))
|
||||
|
||||
|
|
@ -404,12 +370,12 @@
|
|||
nss)
|
||||
addr))]
|
||||
[else
|
||||
(let ([d (rr-data (car ans))])
|
||||
(let ([pref (octet-pair->number (car d) (cadr d))])
|
||||
(if (< pref best-pref)
|
||||
(let-values ([(name start) (parse-name (cddr d) reply)])
|
||||
(loop (cdr ans) pref name))
|
||||
(loop (cdr ans) best-pref exchanger))))]))
|
||||
(define d (rr-data (car ans)))
|
||||
(define pref (octet-pair->number (car d) (cadr d)))
|
||||
(if (< pref best-pref)
|
||||
(let-values ([(name start) (parse-name (cddr d) reply)])
|
||||
(loop (cdr ans) pref name))
|
||||
(loop (cdr ans) best-pref exchanger))]))
|
||||
ars auth?)))
|
||||
nameserver)
|
||||
(error 'dns-get-mail-exchanger "bad address")))
|
||||
|
|
@ -421,34 +387,34 @@
|
|||
(with-input-from-file "/etc/resolv.conf"
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ([l (read-line)])
|
||||
(or (and (string? l)
|
||||
(let ([m (regexp-match
|
||||
#rx"nameserver[ \t]+([0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)"
|
||||
l)])
|
||||
(and m (cadr m))))
|
||||
(and (not (eof-object? l))
|
||||
(loop))))))))]
|
||||
(define line (read-line))
|
||||
(or (and (string? line)
|
||||
(let ([m (regexp-match
|
||||
#rx"nameserver[ \t]+([0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)"
|
||||
line)])
|
||||
(and m (cadr m))))
|
||||
(and (not (eof-object? line))
|
||||
(loop)))))))]
|
||||
[(windows)
|
||||
(let ([nslookup (find-executable-path "nslookup.exe" #f)])
|
||||
(and nslookup
|
||||
(let-values ([(pin pout pid perr proc)
|
||||
(apply
|
||||
values
|
||||
(process/ports
|
||||
#f (open-input-file "NUL") (current-error-port)
|
||||
nslookup))])
|
||||
(let loop ([name #f] [ip #f] [try-ip? #f])
|
||||
(let ([line (read-line pin 'any)])
|
||||
(cond [(eof-object? line)
|
||||
(close-input-port pin)
|
||||
(proc 'wait)
|
||||
(or ip name)]
|
||||
[(and (not name)
|
||||
(regexp-match #rx"^Default Server: +(.*)$" line))
|
||||
=> (lambda (m) (loop (cadr m) #f #t))]
|
||||
[(and try-ip?
|
||||
(regexp-match #rx"^Address: +(.*)$" line))
|
||||
=> (lambda (m) (loop name (cadr m) #f))]
|
||||
[else (loop name ip #f)]))))))]
|
||||
(define nslookup (find-executable-path "nslookup.exe" #f))
|
||||
(and nslookup
|
||||
(let-values ([(pin pout pid perr proc)
|
||||
(apply
|
||||
values
|
||||
(process/ports
|
||||
#f (open-input-file "NUL") (current-error-port)
|
||||
nslookup))])
|
||||
(let loop ([name #f] [ip #f] [try-ip? #f])
|
||||
(define line (read-line pin 'any))
|
||||
(cond [(eof-object? line)
|
||||
(close-input-port pin)
|
||||
(proc 'wait)
|
||||
(or ip name)]
|
||||
[(and (not name)
|
||||
(regexp-match #rx"^Default Server: +(.*)$" line))
|
||||
=> (lambda (m) (loop (cadr m) #f #t))]
|
||||
[(and try-ip?
|
||||
(regexp-match #rx"^Address: +(.*)$" line))
|
||||
=> (lambda (m) (loop name (cadr m) #f))]
|
||||
[else (loop name ip #f)]))))]
|
||||
[else #f]))
|
||||
|
|
|
|||
|
|
@ -34,8 +34,6 @@
|
|||
(struct ipv4 ([bytes (bytes-of-length 4)]))
|
||||
(struct ipv6 ([bytes (bytes-of-length 16)]))))
|
||||
|
||||
(module+ test (require rackunit))
|
||||
|
||||
;; data definitions
|
||||
|
||||
;; An IPAddress is one of
|
||||
|
|
@ -73,26 +71,6 @@
|
|||
[(? (bytes-of-length 4)) (ipv4 input)]
|
||||
[(? (bytes-of-length 16)) (ipv6 input)]))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (make-ip-address "127.0.0.1")
|
||||
(ipv4 (bytes 127 0 0 1)))
|
||||
(check-equal? (make-ip-address (bytes 127 0 0 1))
|
||||
(ipv4 (bytes 127 0 0 1)))
|
||||
(check-equal? (make-ip-address "2607:f8b0:4009:800::100e")
|
||||
(ipv6 (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14)))
|
||||
(check-equal? (make-ip-address (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
(ipv6 (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14)))
|
||||
(check-equal? (make-ip-address "0.0.0.1")
|
||||
(ipv4 (bytes 0 0 0 1)))
|
||||
(check-not-equal? (make-ip-address "128.0.0.1")
|
||||
(make-ip-address "255.3.255.0"))
|
||||
|
||||
(let ([ip-bytes (bytes 127 0 0 1)])
|
||||
(define ip (make-ip-address ip-bytes))
|
||||
(bytes-set! ip-bytes 0 255)
|
||||
(check-equal? ip (make-ip-address "127.0.0.1")
|
||||
"IP addresses should be immutable")))
|
||||
|
||||
(define (ip-address-string? val)
|
||||
(and (string? val)
|
||||
(or (ipv4-string? val)
|
||||
|
|
@ -147,39 +125,6 @@
|
|||
;; this is the +1 octet pair
|
||||
(regexp-match? re-end str))]))))
|
||||
|
||||
(module+ test
|
||||
(check-true (ip-address-string? "0.0.0.0"))
|
||||
(check-true (ip-address-string? "0.1.0.2"))
|
||||
(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")))
|
||||
|
||||
;; String -> Bytes
|
||||
;; converts a string representating an IPv4 address to bytes
|
||||
(define (ipv4-string->bytes ip)
|
||||
|
|
@ -190,16 +135,6 @@
|
|||
(string->number (list-ref result 3))
|
||||
(string->number (list-ref result 4)))))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ipv4-string->bytes "0.8.255.0")
|
||||
(bytes 0 8 255 0))
|
||||
(check-equal? (ipv4-string->bytes "8.8.8.8")
|
||||
(bytes 8 8 8 8))
|
||||
(check-equal? (ipv4-string->bytes "12.81.255.109")
|
||||
(bytes 12 81 255 109))
|
||||
(check-equal? (ipv4-string->bytes "192.168.0.1")
|
||||
(bytes 192 168 0 1)))
|
||||
|
||||
;; String -> Bytes
|
||||
;; converts a string representing an IPv6 address to bytes
|
||||
(define (ipv6-string->bytes ip)
|
||||
|
|
@ -224,22 +159,6 @@
|
|||
(loop (bytes-append result (octet-pair-string->bytes (car splitted)))
|
||||
(cdr splitted))])))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ipv6-string->bytes "2001:0db8:85a3:0000:0000:8a2e:0370:7334")
|
||||
(bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52))
|
||||
(check-equal? (ipv6-string->bytes "2001:200:dff:fff1:216:3eff:feb1:44d7")
|
||||
(bytes 32 1 2 0 13 255 255 241 2 22 62 255 254 177 68 215))
|
||||
(check-equal? (ipv6-string->bytes "2001:db8:85a3:0:0:8a2e:370:7334")
|
||||
(bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52))
|
||||
(check-equal? (ipv6-string->bytes "2001:db8:85a3::8a2e:370:7334")
|
||||
(bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52))
|
||||
(check-equal? (ipv6-string->bytes "2607:f8b0:4009:800::100e")
|
||||
(bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
(check-equal? (ipv6-string->bytes "::1")
|
||||
(bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1))
|
||||
(check-equal? (ipv6-string->bytes "::ffff")
|
||||
(bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255)))
|
||||
|
||||
;; IPAddress -> Bytestring
|
||||
;; Turn an ip struct into a byte string
|
||||
(define (ip-address->bytes ip)
|
||||
|
|
@ -247,12 +166,6 @@
|
|||
[(? ipv4?) (ipv4-bytes ip)]
|
||||
[(? ipv6?) (ipv6-bytes ip)]))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ip-address->bytes (make-ip-address "8.8.8.8"))
|
||||
(bytes 8 8 8 8))
|
||||
(check-equal? (ip-address->bytes (make-ip-address "::1"))
|
||||
(bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)))
|
||||
|
||||
;; IPAddress -> String
|
||||
;; Convert an IP address to a string
|
||||
(define (ip-address->string ip)
|
||||
|
|
@ -260,25 +173,10 @@
|
|||
[(? ipv4?) (ipv4->string (ipv4-bytes ip))]
|
||||
[(? ipv6?) (ipv6->string (ipv6-bytes ip))]))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ip-address->string (make-ip-address "8.8.8.8"))
|
||||
"8.8.8.8")
|
||||
(check-equal? (ip-address->string (make-ip-address "::1"))
|
||||
"::1"))
|
||||
|
||||
;; Bytes -> String
|
||||
;; Convert a bytestring for an IPv4 address to a string
|
||||
(define (ipv4->string bytes)
|
||||
(string-join (for/list ([b bytes]) (~r b)) "."))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ipv4->string (bytes 0 0 0 0)) "0.0.0.0")
|
||||
(check-equal? (ipv4->string (bytes 255 255 0 1))
|
||||
"255.255.0.1")
|
||||
(check-equal? (ipv4->string (bytes 127 0 0 1))
|
||||
"127.0.0.1")
|
||||
(check-equal? (ipv4->string (bytes 8 8 8 8))
|
||||
"8.8.8.8"))
|
||||
(string-join (for/list ([b (in-bytes bytes)]) (~r b)) "."))
|
||||
|
||||
;; Bytes -> String
|
||||
;; Convert a bytestring representing an IPv6 address to a string
|
||||
|
|
@ -291,7 +189,7 @@
|
|||
(define compressed (compress two-octets))
|
||||
;; add an extra "" if :: is at the start
|
||||
(define compressed-strs
|
||||
(for/list ([elem compressed])
|
||||
(for/list ([elem (in-list compressed)])
|
||||
(if (eq? elem '::)
|
||||
"" ; string-join will turn this into ::
|
||||
(~r elem #:base 16))))
|
||||
|
|
@ -301,41 +199,21 @@
|
|||
compressed-strs))
|
||||
(string-join compressed-strs* ":"))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (ipv6->string (bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52))
|
||||
"2001:db8:85a3::8a2e:370:7334")
|
||||
(check-equal? (ipv6->string (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
"2607:f8b0:4009:800::100e")
|
||||
(check-equal? (ipv6->string (bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255))
|
||||
"::ffff")
|
||||
(check-equal? (ipv6->string (bytes 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255))
|
||||
"ffff::ffff"))
|
||||
|
||||
;; (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 zeroes
|
||||
(for/list ([n (in-list 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)))
|
||||
|
||||
;; contract helper
|
||||
(define (bytes-of-length n)
|
||||
(flat-named-contract
|
||||
`(bytes-of-length ,n)
|
||||
(λ (bs) (and (bytes? bs) (= (bytes-length bs) n)))))
|
||||
|
||||
(module+ test
|
||||
(check-true ((bytes-of-length 5) (bytes 1 2 3 4 5)))
|
||||
(check-false ((bytes-of-length 5) "moogle")))
|
||||
|
||||
|
|
|
|||
|
|
@ -2,33 +2,43 @@
|
|||
|
||||
(require net/dns tests/eli-tester)
|
||||
|
||||
;; Run internal unit tests
|
||||
(require (submod net/dns test))
|
||||
;; internal tests
|
||||
(require (only-in rackunit require/expose) net/private/ip)
|
||||
(require/expose net/dns (ip->in-addr.arpa ip->ip6.arpa))
|
||||
(define (internal-tests)
|
||||
(test (ip->in-addr.arpa (ipv4 (bytes 8 8 8 8)))
|
||||
=> "8.8.8.8.in-addr.arpa"
|
||||
(ip->in-addr.arpa (ipv4 (bytes 127 0 0 1)))
|
||||
=> "1.0.0.127.in-addr.arpa"
|
||||
(ip->ip6.arpa (make-ip-address "4321:0:1:2:3:4:567:89ab"))
|
||||
=> (string-append "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")
|
||||
(ip->ip6.arpa (make-ip-address "2001:db8::567:89ab"))
|
||||
=> (string-append "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")))
|
||||
|
||||
;; Constants for testing. These can go out of sync
|
||||
;; when server setups change, so keep them up-to-date.
|
||||
(define *google-dns* "8.8.8.8")
|
||||
(define *google-dns* "8.8.8.8")
|
||||
(define *google-dns-2* "8.8.4.4")
|
||||
(define *racket-url* "racket-lang.org")
|
||||
(define *racket-host* "champlain.ccs.neu.edu")
|
||||
(define *racket-ip* "129.10.115.116")
|
||||
(define *racket-mx* "aspmx.l.google.com")
|
||||
(define *kame-url* "www.kame.net")
|
||||
(define *kame-ip* "2001:200:dff:fff1:216:3eff:feb1:44d7")
|
||||
(define *racket-url* "racket-lang.org")
|
||||
(define *racket-host* "champlain.ccs.neu.edu")
|
||||
(define *racket-ip* "129.10.115.116")
|
||||
(define *racket-mx* "aspmx.l.google.com")
|
||||
(define *kame-url* "www.kame.net")
|
||||
(define *kame-ip* "2001:200:dff:fff1:216:3eff:feb1:44d7")
|
||||
|
||||
(module+ main (tests))
|
||||
(define (dns-test/nameserver nameserver)
|
||||
(define (nameserver-tests nameserver)
|
||||
(test (dns-get-address nameserver *racket-url*) => *racket-ip*
|
||||
(dns-get-address nameserver *racket-host*) => *racket-ip*
|
||||
(dns-get-address nameserver *kame-url* #:ipv6? #t) => *kame-ip*
|
||||
(dns-get-name nameserver *racket-ip*) => *racket-host*
|
||||
(dns-get-mail-exchanger nameserver *racket-url*) => *racket-mx*))
|
||||
|
||||
(provide tests)
|
||||
(module+ main (tests))
|
||||
(define (tests)
|
||||
(dns-test/nameserver *google-dns*)
|
||||
(dns-test/nameserver *google-dns-2*)
|
||||
|
||||
(define ns (dns-find-nameserver))
|
||||
(when ns
|
||||
(dns-test/nameserver ns)))
|
||||
|
||||
(test do (internal-tests)
|
||||
(nameserver-tests *google-dns*)
|
||||
(nameserver-tests *google-dns-2*)
|
||||
(let ([ns (dns-find-nameserver)]) (when ns (nameserver-tests ns)))))
|
||||
|
|
|
|||
125
collects/tests/net/ip.rkt
Normal file
125
collects/tests/net/ip.rkt
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
#lang racket/base
|
||||
|
||||
(require net/private/ip tests/eli-tester)
|
||||
|
||||
(require (only-in rackunit require/expose))
|
||||
(require/expose net/private/ip
|
||||
(ipv4-string->bytes ipv6-string->bytes ipv4->string ipv6->string
|
||||
compress bytes-of-length))
|
||||
|
||||
(provide tests)
|
||||
(module+ main (tests))
|
||||
(define (tests)
|
||||
(test
|
||||
;; ----------------------------------------
|
||||
(make-ip-address "127.0.0.1")
|
||||
=> (ipv4 (bytes 127 0 0 1))
|
||||
(make-ip-address (bytes 127 0 0 1))
|
||||
=> (ipv4 (bytes 127 0 0 1))
|
||||
(make-ip-address "2607:f8b0:4009:800::100e")
|
||||
=> (ipv6 (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
(make-ip-address (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
=> (ipv6 (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
(make-ip-address "0.0.0.1")
|
||||
=> (ipv4 (bytes 0 0 0 1))
|
||||
(not (equal? (make-ip-address "128.0.0.1")
|
||||
(make-ip-address "255.3.255.0")))
|
||||
do (let ([ip-bytes (bytes 127 0 0 1)])
|
||||
(define ip (make-ip-address ip-bytes))
|
||||
(bytes-set! ip-bytes 0 255)
|
||||
(test #:failure-message "IP addresses should be immutable"
|
||||
ip => (make-ip-address "127.0.0.1")))
|
||||
;; ----------------------------------------
|
||||
(ip-address-string? "0.0.0.0")
|
||||
(ip-address-string? "0.1.0.2")
|
||||
(ip-address-string? "8.8.8.8")
|
||||
(ip-address-string? "12.81.255.109")
|
||||
(ip-address-string? "192.168.0.1")
|
||||
(ip-address-string? "2001:0db8:85a3:0000:0000:8a2e:0370:7334")
|
||||
(ip-address-string? "2001:200:dff:fff1:216:3eff:feb1:44d7")
|
||||
(ip-address-string? "2001:db8:85a3:0:0:8a2e:370:7334")
|
||||
(ip-address-string? "2001:db8:85a3::8a2e:370:7334")
|
||||
(ip-address-string? "0:0:0:0:0:0:0:1")
|
||||
(ip-address-string? "0:0:0:0:0:0:0:0")
|
||||
(ip-address-string? "::")
|
||||
(ip-address-string? "::0")
|
||||
(ip-address-string? "::ffff:c000:0280")
|
||||
(ip-address-string? "2001:db8::2:1")
|
||||
(ip-address-string? "2001:db8:0:0:1::1")
|
||||
(not (ip-address-string? ""))
|
||||
(not (ip-address-string? ":::"))
|
||||
(not (ip-address-string? "::0::"))
|
||||
(not (ip-address-string? "2001::db8::2:1"))
|
||||
(not (ip-address-string? "2001:::db8:2:1"))
|
||||
(not (ip-address-string? "52001:db8::2:1"))
|
||||
(not (ip-address-string? "80.8.800.8"))
|
||||
(not (ip-address-string? "80.8.800.0"))
|
||||
(not (ip-address-string? "080.8.800.8"))
|
||||
(not (ip-address-string? "vas8.8.800.8"))
|
||||
(not (ip-address-string? "80.8.128.8dd"))
|
||||
(not (ip-address-string? "0.8.800.008"))
|
||||
(not (ip-address-string? "0.8.800.a8"))
|
||||
(not (ip-address-string? "potatoes"))
|
||||
(not (ip-address-string? "127.0.0"))
|
||||
;; ----------------------------------------
|
||||
(ipv4-string->bytes "0.8.255.0")
|
||||
=> (bytes 0 8 255 0)
|
||||
(ipv4-string->bytes "8.8.8.8")
|
||||
=> (bytes 8 8 8 8)
|
||||
(ipv4-string->bytes "12.81.255.109")
|
||||
=> (bytes 12 81 255 109)
|
||||
(ipv4-string->bytes "192.168.0.1")
|
||||
=> (bytes 192 168 0 1)
|
||||
;; ----------------------------------------
|
||||
(ipv6-string->bytes "2001:0db8:85a3:0000:0000:8a2e:0370:7334")
|
||||
=> (bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52)
|
||||
(ipv6-string->bytes "2001:200:dff:fff1:216:3eff:feb1:44d7")
|
||||
=> (bytes 32 1 2 0 13 255 255 241 2 22 62 255 254 177 68 215)
|
||||
(ipv6-string->bytes "2001:db8:85a3:0:0:8a2e:370:7334")
|
||||
=> (bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52)
|
||||
(ipv6-string->bytes "2001:db8:85a3::8a2e:370:7334")
|
||||
=> (bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52)
|
||||
(ipv6-string->bytes "2607:f8b0:4009:800::100e")
|
||||
=> (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14)
|
||||
(ipv6-string->bytes "::1")
|
||||
=> (bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(ipv6-string->bytes "::ffff")
|
||||
=> (bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255)
|
||||
;; ----------------------------------------
|
||||
(ip-address->bytes (make-ip-address "8.8.8.8"))
|
||||
=> (bytes 8 8 8 8)
|
||||
(ip-address->bytes (make-ip-address "::1"))
|
||||
=> (bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
;; ----------------------------------------
|
||||
(ip-address->string (make-ip-address "8.8.8.8"))
|
||||
=> "8.8.8.8"
|
||||
(ip-address->string (make-ip-address "::1"))
|
||||
=> "::1"
|
||||
;; ----------------------------------------
|
||||
(ipv4->string (bytes 0 0 0 0))
|
||||
=> "0.0.0.0"
|
||||
(ipv4->string (bytes 255 255 0 1))
|
||||
=> "255.255.0.1"
|
||||
(ipv4->string (bytes 127 0 0 1))
|
||||
=> "127.0.0.1"
|
||||
(ipv4->string (bytes 8 8 8 8))
|
||||
=> "8.8.8.8"
|
||||
;; ----------------------------------------
|
||||
(ipv6->string (bytes 32 1 13 184 133 163 0 0 0 0 138 46 3 112 115 52))
|
||||
=> "2001:db8:85a3::8a2e:370:7334"
|
||||
(ipv6->string (bytes 38 7 248 176 64 9 8 0 0 0 0 0 0 0 16 14))
|
||||
=> "2607:f8b0:4009:800::100e"
|
||||
(ipv6->string (bytes 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255))
|
||||
=> "::ffff"
|
||||
(ipv6->string (bytes 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255))
|
||||
=> "ffff::ffff"
|
||||
;; ----------------------------------------
|
||||
(compress '(0 0 0 5 5)) => '(:: 5 5)
|
||||
(compress '(0 5 5)) => '(0 5 5)
|
||||
(compress '(0 0 5 0 0 5)) => '(:: 5 0 0 5)
|
||||
(compress '(0 5 0 0 0 5)) => '(0 5 :: 5)
|
||||
;; ----------------------------------------
|
||||
((bytes-of-length 5) (bytes 1 2 3 4 5))
|
||||
(not ((bytes-of-length 5) "moogle"))
|
||||
;; ----------------------------------------
|
||||
))
|
||||
|
|
@ -1,6 +1,8 @@
|
|||
#lang racket/base
|
||||
|
||||
(require tests/eli-tester
|
||||
(prefix-in ip: "ip.rkt")
|
||||
(prefix-in dns: "dns.rkt")
|
||||
(prefix-in ucodec: "uri-codec.rkt")
|
||||
(prefix-in url: "url.rkt")
|
||||
(prefix-in cgi: "cgi.rkt")
|
||||
|
|
@ -13,7 +15,9 @@
|
|||
(prefix-in websocket: "websocket.rkt"))
|
||||
|
||||
(define (tests)
|
||||
(test do (url:tests)
|
||||
(test do (ip:tests)
|
||||
do (dns:tests)
|
||||
do (url:tests)
|
||||
do (ucodec:tests)
|
||||
do (ucodec:noels-tests)
|
||||
do (cgi:tests)
|
||||
|
|
|
|||
|
|
@ -43,7 +43,9 @@
|
|||
(test (combine-url/relative-vec (->vec base) relative)
|
||||
=> (->vec expected)))
|
||||
|
||||
(define (run-tests)
|
||||
(provide tests)
|
||||
(module+ main (tests))
|
||||
(define (tests)
|
||||
(test
|
||||
;; Test the current-proxy-servers parameter can be set
|
||||
(parameterize ([current-proxy-servers '(("http" "proxy.com" 3128))])
|
||||
|
|
@ -373,7 +375,3 @@
|
|||
))
|
||||
|
||||
)
|
||||
|
||||
(provide tests)
|
||||
(module+ main (tests))
|
||||
(define (tests) (test do (run-tests)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user