110 lines
2.7 KiB
Racket
110 lines
2.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 msg:update msg [subnet pref self-origin? as-path origin]
|
|
;; subnet : Subnet
|
|
;; pref : Int
|
|
;; self-origin? : Boolean
|
|
;; as-path : [Listof Int]
|
|
;; origin : (U 'IGP 'EGP 'UNK)
|
|
#: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)
|
|
|
|
;; 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"]))
|
|
|
|
;; 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
|
|
(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)
|
|
(bytes->jsexpr
|
|
(jsexpr->msg bs)))
|
|
|
|
(module+ test
|
|
(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")
|
|
(subnet (string->ip "1.2.3.5") 7)
|
|
100
|
|
#t
|
|
'(1 2)
|
|
'UNK)))
|