166 lines
4.7 KiB
Racket
166 lines
4.7 KiB
Racket
#lang racket
|
|
(provide (all-defined-out))
|
|
|
|
(require json
|
|
"iputil.rkt")
|
|
|
|
(module+ test
|
|
(require rackunit))
|
|
|
|
;; src, dst : IP
|
|
;; data : Any
|
|
(struct msg [src dst]
|
|
#:transparent)
|
|
|
|
(struct route [nexthop subnet pref self-origin? as-path origin]
|
|
;; nexthop : IP
|
|
;; subnet : Subnet
|
|
;; pref : Int
|
|
;; self-origin? : Boolean
|
|
;; as-path : [Listof Int]
|
|
;; origin : (U 'IGP 'EGP 'UNK)
|
|
#:transparent)
|
|
|
|
(struct msg:update msg [route]
|
|
;; route : Route
|
|
#:transparent)
|
|
|
|
(struct msg:revoke msg [networks]
|
|
;; networks : [Listof Subnet]
|
|
#:transparent)
|
|
|
|
(struct msg:data msg [stuff]
|
|
;; stuff : Any
|
|
#:transparent)
|
|
|
|
(struct msg:no-route msg []
|
|
#:transparent)
|
|
|
|
(struct msg:dump msg []
|
|
#:transparent)
|
|
|
|
(struct msg:table msg [networks]
|
|
;; networks : [Listof [List Subnet IP]]
|
|
#:transparent)
|
|
|
|
;; Any -> Msg
|
|
(define (jsexpr->msg j)
|
|
(define src (string->ip (hash-ref j 'src)))
|
|
(define dst (string->ip (hash-ref j 'dst)))
|
|
(define type (hash-ref j 'type))
|
|
(define data (hash-ref j 'msg))
|
|
|
|
(define (hash->subnet h)
|
|
(subnet (string->ip (hash-ref h 'network))
|
|
(ip-netmask (string->ip (hash-ref h 'netmask)))))
|
|
|
|
(match type
|
|
["update"
|
|
(msg:update src dst
|
|
(route src
|
|
(hash->subnet data)
|
|
(hash-ref data 'localpref)
|
|
(hash-ref data 'selfOrigin)
|
|
(hash-ref data 'ASPath)
|
|
(string->symbol (hash-ref data 'origin))))]
|
|
["revoke"
|
|
(msg:revoke src dst
|
|
(map hash->subnet data))]
|
|
["data"
|
|
(msg:data src dst
|
|
data)]
|
|
["no route"
|
|
(msg:no-route src dst)]
|
|
["dump"
|
|
(msg:dump src dst)]
|
|
["table"
|
|
(msg:table src dst
|
|
(map (λ (h) (list (hash->subnet h)
|
|
(string->ip (hash-ref h 'peer))))
|
|
data))]))
|
|
|
|
;; Bytes -> Msg
|
|
(define (bytes->msg bs)
|
|
(jsexpr->msg (bytes->jsexpr bs)))
|
|
|
|
;; Msg -> String
|
|
(define (msg-type m)
|
|
(cond
|
|
[(msg:update? m) "update"]
|
|
[(msg:revoke? m) "revoke"]
|
|
[(msg:data? m) "data"]
|
|
[(msg:no-route? m) "no route"]
|
|
[(msg:dump? m) "dump"]
|
|
[(msg:table? m) "table"]))
|
|
|
|
;; Msg -> Any
|
|
(define (msg->jsexpr msg)
|
|
(hash 'src (ip->string (msg-src msg))
|
|
'dst (ip->string (msg-dst msg))
|
|
'type (msg-type msg)
|
|
'msg (match msg
|
|
[(msg:data _ _ data) data]
|
|
[(msg:no-route _ _) (hash)]
|
|
|
|
[(msg:update _ _
|
|
(route _
|
|
net
|
|
pref
|
|
self-orig?
|
|
as
|
|
org))
|
|
(hash 'network (ip->string (subnet-ip net))
|
|
'netmask (ip->string (netmask-ip (subnet-mask net)))
|
|
'localpref pref
|
|
'selfOrigin self-orig?
|
|
'ASPath as
|
|
'origin (symbol->string org))]
|
|
|
|
[_ (error 'msg->jsexpr
|
|
(format "unimplemented ~a" (msg-type msg)))])))
|
|
|
|
;; Msg -> Bytes
|
|
(define (msg->bytes msg)
|
|
(jsexpr->bytes (msg->jsexpr msg)))
|
|
|
|
(module+ test
|
|
(check-equal? (msg->jsexpr
|
|
(msg:update
|
|
(string->ip "1.2.3.4")
|
|
(string->ip "1.2.3.7")
|
|
(route (string->ip "1.2.3.4")
|
|
(subnet (string->ip "1.2.3.5") 25)
|
|
100
|
|
#t
|
|
'(1 2)
|
|
'UNK)))
|
|
(hash 'src "1.2.3.4"
|
|
'dst "1.2.3.7"
|
|
'type "update"
|
|
'msg (hash 'network "1.2.3.5"
|
|
'netmask "255.255.255.128"
|
|
'localpref 100
|
|
'selfOrigin #t
|
|
'ASPath '(1 2)
|
|
'origin "UNK")))
|
|
|
|
(check-equal? (jsexpr->msg
|
|
(hash 'src "1.2.3.4"
|
|
'dst "1.2.3.7"
|
|
'type "update"
|
|
'msg (hash 'network "1.2.3.5"
|
|
'netmask "255.255.255.128"
|
|
'localpref 100
|
|
'selfOrigin #t
|
|
'ASPath '(1 2)
|
|
'origin "UNK")))
|
|
(msg:update
|
|
(string->ip "1.2.3.4")
|
|
(string->ip "1.2.3.7")
|
|
(route (string->ip "1.2.3.4")
|
|
(subnet (string->ip "1.2.3.5") 25)
|
|
100
|
|
#t
|
|
'(1 2)
|
|
'UNK))))
|