Implement actual dump response

This commit is contained in:
xenia 2020-02-01 22:21:25 -05:00
parent d24df65c34
commit 222d9ce31c
3 changed files with 33 additions and 17 deletions

View File

@ -116,6 +116,12 @@
'ASPath as 'ASPath as
'origin (symbol->string org))] 'origin (symbol->string org))]
[(msg:table _ _ networks)
(for/list ([entry (in-list networks)])
(hash 'network (ip->string (subnet-ip (first entry)))
'netmask (ip->string (netmask-ip (subnet-mask (first entry))))
'peer (ip->string (second entry))))]
[_ (error 'msg->jsexpr [_ (error 'msg->jsexpr
(format "unimplemented ~a" (msg-type msg)))]))) (format "unimplemented ~a" (msg-type msg)))])))

View File

@ -83,13 +83,12 @@
visited]))) visited])))
(define (rt-flatten node) (define (rt-flatten node)
(if node (define (flatten-edge e) (if e (rt-flatten (rt-edge-target e)) '()))
(let* ([e1 (rt-node-edge0 node)] (let* ([e1 (rt-node-edge0 node)]
[e2 (rt-node-edge1 node)] [e2 (rt-node-edge1 node)]
[data (rt-node-data node)] [data (rt-node-data node)]
[rst (append (rt-flatten e1) (rt-flatten e2))]) [rst (apply append (map flatten-edge (list e1 e2)))])
(if (equal? data empty-node-data) rst (cons data rst))) (if (equal? data empty-node-data) rst (cons data rst))))
'()))
; (define test (make-rt)) ; (define test (make-rt))
; (define (test-insert! x) ; (define (test-insert! x)

31
router
View File

@ -1,6 +1,7 @@
#!/usr/bin/env racket #!/usr/bin/env racket
#lang racket #lang racket
; vim:syntax=racket ; vim:syntax=racket
; vim:ft=racket
(require json (require json
"iputil.rkt" "iputil.rkt"
@ -29,6 +30,10 @@
(lambda (rst) (cons (cons peer r) rst)) (lambda (rst) (cons (cons peer r) rst))
(lambda () '()))) (lambda () '())))
;; IP -> IP
(define (peer-ip->own-ip p)
(sub1 p))
(define (route< r1 r2) (define (route< r1 r2)
#| #|
(route< r1 r2) iff "r1 wins" (route< r1 r2) iff "r1 wins"
@ -66,9 +71,13 @@
;; Router -> Msg ;; Router -> Msg
;; Dumps routing table ;; Dumps routing table
(define (router-dump rt src dst) (define (router-dump rt src dst)
(msg:table (sub1 src) src (define routing-table (rt-flatten rt))
(map (lambda (route) (list (route-subnet route) (route-nexthop route))) (msg:table (peer-ip->own-ip src) src
(rt-flatten rt)))) (for/fold ([entries '()]) ([routes (in-list routing-table)])
(append entries (map (lambda (route)
(list (route-subnet (cdr route))
(route-nexthop (cdr route))))
routes)))))
;; Str [Listof Peer-Conn] -> Void ;; Str [Listof Peer-Conn] -> Void
;; -- ;; --
@ -103,8 +112,8 @@
(make-router)) (make-router))
(let loop () (let loop ()
(match-define (list src-peer-conn msg) (channel-get mail)) (match-define (list src-peer msg) (channel-get mail))
(printf "====\nfrom ~a:\n~s\n" src-peer-conn msg) (printf "====\nfrom ~a:\n~s\n" src-peer msg)
;; [Listof [Cons Peer-Conn Msg]] ;; [Listof [Cons Peer-Conn Msg]]
(define to-send (define to-send
@ -116,19 +125,21 @@
(ip->peer src)) (ip->peer src))
(rt-dump router) (rt-dump router)
(for/list ([pc (in-list peer-conns)] (for/list ([pc (in-list peer-conns)]
#:when (not (eq? pc src-peer-conn))) #:when (not (eq? (peer-conn-info pc) src-peer)))
(cons pc msg))] (match-define (peer-conn peer _ _) pc)
(cons pc (msg:update (peer-ip->own-ip (peer-ip peer)) (peer-ip peer) r)))]
[(msg:data src dst data) [(msg:data src dst data)
(match (router-find-best router dst) (match (router-find-best router dst)
[#f [#f
(list (cons src-peer-conn (list (cons (peer->peer-conn src-peer)
(msg:no-route (sub1 src) (msg:no-route (peer-ip->own-ip src)
src)))] src)))]
[dst-peer [dst-peer
(list (cons (peer->peer-conn dst-peer) (list (cons (peer->peer-conn dst-peer)
msg))])] msg))])]
[(msg:dump src dst)
(list (cons (peer->peer-conn src-peer) (router-dump router src dst)))]
[_ [_
(printf "----\nignored\n") (printf "----\nignored\n")
'()])) '()]))