Implement aggregation (no disaggregation yet)

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])

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

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
+  (define flipped-net (subnet-flip-last (route-subnet r)))
-              (subnet->bl (route-subnet r))
+  (define flipped-bl (subnet->bl flipped-net))
-              (lambda (rst) (cons (cons peer r) rst))
+  (define flipped-route (struct-copy route r [subnet flipped-net]))
-              (lambda () '())))
+  (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