diff --git a/private/iputil.rkt b/private/iputil.rkt index 4ecbaa5..ccfa484 100644 --- a/private/iputil.rkt +++ b/private/iputil.rkt @@ -9,6 +9,8 @@ subnet->string string->peer subnet->bl + subnet-flip-last + subnet-drop-last ip->bl) (require racket/struct) @@ -96,6 +98,24 @@ (define (subnet->bl sub) (ip->bl (subnet-ip sub) (subnet-mask sub))) +;; [Listof Bool] -> [Listof Bool] +;; Flips the last bit of the given bit list +(define (bl-flip-last bl) +;; cursed line + (match bl + [`(,f ... ,l) `(,@f ,(not l))])) + +;; Subnet -> Subnet +;; Provides a subnet with the last bit flipped +(define (subnet-flip-last sub) + (subnet (bitwise-xor (arithmetic-shift 1 (- 32 (subnet-mask sub))) (subnet-ip sub)) + (subnet-mask sub))) + +(define (subnet-drop-last sub) + (match-define (subnet ip mask) sub) + (subnet (arithmetic-shift (arithmetic-shift ip (- mask 33)) (- 33 mask)) + (sub1 mask))) + ;; IP -> [Listof Bool] ;; Converts an IP address into a list of booleans representing its bits (define (ip->bl ip [bits 32]) diff --git a/private/radix-tree.rkt b/private/radix-tree.rkt index 2fef0f7..31daf9f 100644 --- a/private/radix-tree.rkt +++ b/private/radix-tree.rkt @@ -18,7 +18,7 @@ (struct rt-edge [label target] #:transparent) ;; A unique symbol representing no data associated with a certain node -(define empty-node-data (gensym 'MEOW)) +(define empty-node-data '()) ;(gensym 'MEOW) ;; -> RT ;; Creates a new empty RT diff --git a/router b/router index 80ee826..a0b91e0 100755 --- a/router +++ b/router @@ -29,11 +29,21 @@ ;; Router Route Peer -> Void ;; Adds route r from peer to the routing database +;; Aggregates routes according to the aggregation rules (define (router-add! rt r peer) - (rt-update! rt - (subnet->bl (route-subnet r)) - (lambda (rst) (cons (cons peer r) rst)) - (lambda () '()))) + (define flipped-net (subnet-flip-last (route-subnet r))) + (define flipped-bl (subnet->bl flipped-net)) + (define flipped-route (struct-copy route r [subnet flipped-net])) + (define aggregate-route (rt-lookup rt flipped-bl (lambda () '()))) + (cond + [(member (cons peer flipped-route) aggregate-route) + (define new-aggregate-route (remove (cons peer flipped-route) aggregate-route)) + (rt-update! rt flipped-bl (lambda (_) new-aggregate-route) (lambda () '())) + (router-add! rt (struct-copy route r [subnet (subnet-drop-last (route-subnet r))]) peer)] + [else (rt-update! rt + (subnet->bl (route-subnet r)) + (lambda (rst) (cons (cons peer r) rst)) + (lambda () '()))])) ;; Router Route Peer -> Void ;; Tries to find the given route and removes it from the routing database