Can we make it so that IP addresses are immutable? This would require changing make-ip-address to have a call to make-immutable-bytes in each case.
On Thu, Apr 4, 2013 at 10:07 AM, <as...@racket-lang.org> wrote: > asumu has updated `master' from 8246d073c0 to 92102a2f07. > http://git.racket-lang.org/plt/8246d073c0..92102a2f07 > > =====[ 2 Commits ]====================================================== > Directory summary: > 55.6% collects/net/private/ > 44.3% collects/net/ > > ~~~~~~~~~~ > > 4e76ae8 Asumu Takikawa <as...@racket-lang.org> 2013-04-03 15:05 > : > | Add an IP address library > | > | The library currently lives in a private subfolder so > | that the interface can still be changed. The idea is to > | eventually make it a top-level `net` library once it is > | more mature. > : > A collects/net/private/ip.rkt > > ~~~~~~~~~~ > > 92102a2 Asumu Takikawa <as...@racket-lang.org> 2013-04-04 11:53 > : > | Use net/private/ip in net/dns > | > | This simplifies the code by outsourcing IP > | address functionality to net/private/ip. > : > M collects/net/dns.rkt | 230 > +++++++++++++----------------------------------- > > =====[ Overall Diff ]=================================================== > > collects/net/dns.rkt > ~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/net/dns.rkt > +++ NEW/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 (ip->string s) > - (format "~a.~a.~a.~a" > - (list-ref s 0) (list-ref s 1) (list-ref s 2) (list-ref s 3))) > + (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)))) > + > +;; 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)]) > > collects/net/private/ip.rkt > ~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- /dev/null > +++ NEW/collects/net/private/ip.rkt > @@ -0,0 +1,323 @@ > +#lang racket/base > + > +;; A library for manipulating IP Addresses > + > +(require racket/bool > + racket/contract > + racket/format > + racket/list > + racket/match > + racket/string > + unstable/sequence) > + > +(provide > + (contract-out > + ;; check if a given value is an IP address > + [ip-address? (-> any/c boolean?)] > + > + ;; check if a given string is a valid representation of an IP address > + [ip-address-string? (-> string? boolean?)] > + > + ;; construct an IP address from various inputs > + [make-ip-address > + (-> (or/c ip-address-string? > + (bytes-of-length 4) > + (bytes-of-length 16)) > + ip-address?)] > + > + ;; construct a string representation of the address > + [ip-address->string (-> ip-address? string?)] > + > + ;; return a byte string representation of the address > + [ip-address->bytes (-> ip-address? bytes?)] > + > + (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 > +;; (ipv4 4Bytes) > +;; (ipv6 16Bytes) > +;; > +;; interp. an IPv4 address represented as four bytes > +;; an IPv6 address represented as sixteen bytes > + > +(define (ip-address? x) (or (ipv4? x) (ipv6? x))) > + > +(struct ipv4 (bytes) > + #:transparent > + #:methods gen:equal+hash > + [(define (equal-proc addr1 addr2 rec) > + (equal? (ipv4-bytes addr1) (ipv4-bytes addr1))) > + (define (hash-proc addr rec) (rec (ipv4-bytes addr))) > + (define (hash2-proc addr rec) (rec (ipv4-bytes addr)))]) > + > +(struct ipv6 (bytes) > + #:transparent > + #:methods gen:equal+hash > + [(define (equal-proc addr1 addr2 rec) > + (equal? (ipv6-bytes addr1) (ipv6-bytes addr1))) > + (define (hash-proc addr rec) (rec (ipv6-bytes addr))) > + (define (hash2-proc addr rec) (rec (ipv6-bytes addr)))]) > + > +(define (make-ip-address input) > + (match input > + ;; TODO: make more efficient by not double checking > + [(? ipv4-string?) (ipv4 (ipv4-string->bytes input))] > + [(? ipv6-string?) (ipv6 (ipv6-string->bytes input))] > + [(? (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)))) > + > +(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"))) > + > +;; String -> Bytes > +;; converts a string representating an IPv4 address to bytes > +(define (ipv4-string->bytes ip) > + (let ([result (regexp-match > #rx"^([0-9]+)\\.([0-9]+)\\.([0-9]+)\\.([0-9]+)$" > + ip)]) > + (bytes (string->number (list-ref result 1)) > + (string->number (list-ref result 2)) > + (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) > + ;; String -> Bytes of length 2 > + ;; turn a string of two octets and write two bytes > + (define (octet-pair-string->bytes two-octs) > + (define n (string->number two-octs 16)) > + (define byte1 (arithmetic-shift (bitwise-and #xff00 n) -8)) > + (define byte2 (bitwise-and #x00ff n)) > + (bytes byte1 byte2)) > + > + (define has-::? (regexp-match? #rx"::" ip)) > + (define splitted (regexp-split #rx":" ip)) > + (define not-empty-str (filter (λ (s) (not (string=? "" s))) splitted)) > + (define pad-amount (* 2 (- 8 (length not-empty-str)))) > + (let loop ([result #""] [splitted splitted]) > + (cond [(empty? splitted) result] > + [(string=? (car splitted) "") > + (loop (bytes-append result (make-bytes pad-amount 0)) > + (remove* '("") (cdr splitted)))] > + [else > + (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) > + (match ip > + [(? 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) > + (match ip > + [(? 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")) > + > +;; Bytes -> String > +;; Convert a bytestring representing an IPv6 address to a string > +(define (ipv6->string bytes) > + (define two-octets > + (for/list ([oct-pair (in-slice 2 (in-bytes bytes))]) > + (define oct1 (car oct-pair)) > + (define oct2 (cadr oct-pair)) > + (+ (arithmetic-shift oct1 8) oct2))) > + (define compressed (compress two-octets)) > + ;; add an extra "" if :: is at the start > + (define compressed-strs > + (for/list ([elem compressed]) > + (if (eq? elem '::) > + "" ; string-join will turn this into :: > + (~r elem #:base 16)))) > + (define compressed-strs* > + (if (string=? (car compressed-strs) "") > + (cons "" compressed-strs) > + 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 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) (= (bytes-length bs) n)))) > + _________________________ Racket Developers list: http://lists.racket-lang.org/dev