2020-01-29 21:23:07 +00:00
|
|
|
#lang racket
|
|
|
|
|
2020-01-30 23:09:05 +00:00
|
|
|
(provide (struct-out peer) (struct-out subnet)
|
2020-01-29 21:23:07 +00:00
|
|
|
string->ip
|
|
|
|
ip->string
|
2020-01-31 00:32:01 +00:00
|
|
|
ip-netmask
|
2020-02-01 04:38:32 +00:00
|
|
|
netmask-ip
|
2020-01-29 21:23:07 +00:00
|
|
|
string->subnet
|
|
|
|
subnet->string
|
2020-02-01 03:18:46 +00:00
|
|
|
string->peer
|
|
|
|
subnet->bl
|
|
|
|
ip->bl)
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-01-31 00:32:01 +00:00
|
|
|
(require racket/struct)
|
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Support functions for dealing with IP addresses, subnets, and peers
|
|
|
|
|
2020-01-31 00:32:01 +00:00
|
|
|
(module+ test
|
|
|
|
(require rackunit))
|
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; An IP is a Nat
|
|
|
|
|
|
|
|
;; A PeerType is one of
|
|
|
|
;; - 'prov
|
|
|
|
;; - 'cust
|
|
|
|
;; - 'peer
|
|
|
|
|
|
|
|
;; A Peer is a (peer IP PeerType)
|
2020-01-29 21:23:07 +00:00
|
|
|
(struct peer [ip type]
|
2020-01-31 00:47:32 +00:00
|
|
|
#:transparent
|
2020-01-30 23:09:05 +00:00
|
|
|
#:methods gen:custom-write
|
|
|
|
[(define write-proc
|
|
|
|
(make-constructor-style-printer
|
|
|
|
(lambda (x) 'peer)
|
|
|
|
(lambda (x) (list (ip->string (peer-ip x)) (peer-type x)))))])
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; A Subnet is a (subnet IP Nat)
|
2020-01-29 21:23:07 +00:00
|
|
|
(struct subnet [ip mask]
|
2020-01-31 00:47:32 +00:00
|
|
|
#:transparent
|
2020-01-30 23:09:05 +00:00
|
|
|
#:methods gen:custom-write
|
|
|
|
[(define write-proc
|
|
|
|
(make-constructor-style-printer
|
|
|
|
(lambda (x) 'subnet)
|
|
|
|
(lambda (x) (list (subnet->string x)))))])
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Str -> IP
|
|
|
|
;; Parses the IP address contained in str
|
2020-01-29 21:23:07 +00:00
|
|
|
(define (string->ip str)
|
2020-01-30 23:09:05 +00:00
|
|
|
(define parts (reverse (string-split str ".")))
|
|
|
|
(for/sum ([part (in-list parts)]
|
|
|
|
[i (in-naturals)])
|
|
|
|
(arithmetic-shift (string->number part)
|
|
|
|
(* i 8))))
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; IP -> Str
|
|
|
|
;; Serializes the IP address ip to a string
|
2020-01-29 21:23:07 +00:00
|
|
|
(define (ip->string ip)
|
2020-01-30 23:09:05 +00:00
|
|
|
(define parts
|
|
|
|
(reverse (for/list ([i (in-range 4)])
|
|
|
|
(number->string (bitwise-and (arithmetic-shift ip (* i -8))
|
|
|
|
255)))))
|
|
|
|
(string-join parts "."))
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; IP -> Nat
|
|
|
|
;; Calculates how many mask bits are set in the given netmask represented as an IP address
|
|
|
|
;; Example: 255.0.0.0 -> 8
|
2020-01-31 00:32:01 +00:00
|
|
|
(define (ip-netmask ip)
|
2020-01-31 22:30:07 +00:00
|
|
|
(- 32
|
|
|
|
(for/sum ([i (in-range 32)])
|
|
|
|
#:break (positive? (bitwise-and ip (arithmetic-shift 1 i)))
|
|
|
|
1)))
|
2020-01-31 00:32:01 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Nat -> IP
|
|
|
|
;; Creates an IP address representing the given netmask size
|
|
|
|
;; Example: 8 -> 255.0.0.0
|
2020-02-01 04:38:32 +00:00
|
|
|
(define (netmask-ip mask)
|
|
|
|
(arithmetic-shift (sub1 (arithmetic-shift 1 mask))
|
|
|
|
(- 32 mask)))
|
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Str -> Subnet
|
|
|
|
;; Parses a subnet from string
|
2020-01-29 21:23:07 +00:00
|
|
|
(define (string->subnet str)
|
2020-01-30 23:09:05 +00:00
|
|
|
(match-define (list ipstr maskstr) (string-split str "/"))
|
|
|
|
(subnet (string->ip ipstr)
|
|
|
|
(string->number maskstr)))
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Subnet -> Str
|
|
|
|
;; Serializes a subnet to string
|
2020-01-29 21:23:07 +00:00
|
|
|
(define (subnet->string sub)
|
2020-01-30 23:09:05 +00:00
|
|
|
(format "~a/~a"
|
2020-01-31 00:32:01 +00:00
|
|
|
(ip->string (subnet-ip sub))
|
2020-01-30 23:09:05 +00:00
|
|
|
(subnet-mask sub)))
|
2020-01-29 21:23:07 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Subnet -> [Listof Bool]
|
|
|
|
;; Converts a subnet into a list of booleans representing its bits
|
2020-02-01 02:27:51 +00:00
|
|
|
(define (subnet->bl sub)
|
2020-02-01 03:11:42 +00:00
|
|
|
(ip->bl (subnet-ip sub) (subnet-mask sub)))
|
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; IP -> [Listof Bool]
|
|
|
|
;; Converts an IP address into a list of booleans representing its bits
|
2020-02-01 03:11:42 +00:00
|
|
|
(define (ip->bl ip [bits 32])
|
|
|
|
(for/list ([i (in-range bits)])
|
|
|
|
(= 1 (bitwise-and 1 (arithmetic-shift ip (- i 31))))))
|
2020-02-01 02:27:51 +00:00
|
|
|
|
2020-02-02 04:55:14 +00:00
|
|
|
;; Str -> Peer
|
|
|
|
;; Parses a peer from string
|
2020-01-29 21:23:07 +00:00
|
|
|
(define (string->peer str)
|
2020-01-30 23:09:05 +00:00
|
|
|
(match-define (list ip type) (string-split str "-"))
|
|
|
|
(peer (string->ip ip) (string->symbol type)))
|
2020-01-31 00:32:01 +00:00
|
|
|
|
|
|
|
;; ================================================================================
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
(check-equal? (ip->string (string->ip "123.84.0.67")) "123.84.0.67")
|
|
|
|
(check-equal? (ip->string (string->ip "0.0.0.0")) "0.0.0.0")
|
|
|
|
|
2020-02-01 04:38:32 +00:00
|
|
|
(check-equal? (ip->string (netmask-ip 23)) "255.255.254.0")
|
|
|
|
(check-equal? (ip->string (netmask-ip 8)) "255.0.0.0")
|
|
|
|
|
2020-02-01 02:27:51 +00:00
|
|
|
(check-equal? (ip-netmask (string->ip "255.255.254.0")) 23)
|
|
|
|
(check-equal? (ip-netmask (string->ip "255.0.0.0")) 8)
|
|
|
|
(check-equal? (subnet->bl (string->subnet "3.3.0.0/24"))
|
|
|
|
'(#f #f #f #f #f #f #t #t
|
|
|
|
#f #f #f #f #f #f #t #t
|
|
|
|
#f #f #f #f #f #f #f #f)))
|