Sorry make-immutable-bytes should be bytes->immutable-bytes. On Thu, Apr 4, 2013 at 10:29 AM, Eric Dobson <eric.n.dob...@gmail.com> wrote: > 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
