[racket-dev] [plt] Push #26558: master branch updated
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}