[racket-dev] [plt] Push #26558: master branch updated
Sorry make-immutable-bytes should be bytes->immutable-bytes.
On Thu, Apr 4, 2013 at 10:29 AM, Eric Dobson <eric.n.dobson at 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, <asumu at 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 <asumu at 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 <asumu at 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))))
>> +
![[logo]](/logo.png){kind=logo}