Implement actual dump response
This commit is contained in:
parent
d24df65c34
commit
222d9ce31c
6
msg.rkt
6
msg.rkt
|
@ -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)))])))
|
||||||
|
|
||||||
|
|
|
@ -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
31
router
|
@ -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")
|
||||||
'()]))
|
'()]))
|
||||||
|
|
Loading…
Reference in New Issue