Implement disaggregation :meowdab:

private/iputil.rkt

@@ -11,6 +11,7 @@
          subnet->bl
          subnet-flip-last
          subnet-drop-last
+         subnet-disaggregate
          ip->bl)
 
 (require racket/struct)
@@ -116,6 +117,16 @@
   (subnet (arithmetic-shift (arithmetic-shift ip (- mask 33)) (- 33 mask))
           (sub1 mask)))
 
+;; Subnet Subnet -> [Listof Subnet]
+;; Given an aggregate subnet and a component part, return an optimal list of
+;; subnets filling the address space represented by (agg - part)
+(define (subnet-disaggregate agg part)
+  (define diff (- (subnet-mask part) (subnet-mask agg)))
+  (define part-flip (subnet-flip-last part))
+  (cond
+    [(= 1 diff) (list part-flip)]
+    [else (cons part-flip (subnet-disaggregate agg (subnet-drop-last part)))]))
+
 ;; 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

@@ -46,7 +46,7 @@
 ;; Helper function that performs tree iteration
 (define (rt-partial-iterate node key [visited '()])
   (cond
-    [(empty? key) (list 'exact node)]
+    [(empty? key) (list 'exact node (cons node visited))]
     [else
      (let* ([bit (first key)]
             [getter (rt-getter bit)]
@@ -89,7 +89,7 @@
                [common-edge (rt-edge (take key prefix-len) common-node)])
           (setter! node common-edge)))))
   (match (rt-partial-iterate node key)
-    [(list 'exact node)
+    [(list 'exact node _)
      (set-rt-node-data! node
                         (cons elem (rt-node-data node)))]
     [(list 'partial node orig-edge prefix-len partial-key visited)
@@ -101,7 +101,7 @@
 ;; Delete all entries under the given key
 (define (rt-del! node key del?)
   (for ([node (in-list (match (rt-partial-iterate node key)
-                         [(list 'exact node) (list node)]
+                         [(list 'exact node _) (list node)]
                          [(list _ ... visited) visited]))])
     (set-rt-node-data! node
                        (filter (negate del?)
@@ -112,7 +112,6 @@
 ;; least-specific.
 (define (rt-lookup node key)
   (match (rt-partial-iterate node key)
-    [(list 'exact node) (rt-node-data node)]
     [(list _ ... visited) (append-map rt-node-data visited)]))
 
 ;; RT -> [Listof Any]

router

@@ -33,11 +33,11 @@
 (define (router-add! rt r peer)
   (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 flipped-route (route-update-subnet r flipped-net))
   (cond
     [(member (cons peer flipped-route)
              (rt-lookup rt flipped-bl))
-     (define r* (struct-copy route r [subnet (subnet-drop-last (route-subnet r))]))
+     (define r* (route-update-subnet r (subnet-drop-last (route-subnet r))))
      (rt-del! rt flipped-bl (curry equal? (cons peer flipped-route)))
      (router-add! rt r* peer)]
     [else
@@ -48,17 +48,39 @@
 ;; Router Route Peer -> Void
 ;; Tries to find the given route and removes it from the routing database
 (define (router-revoke! rt subnet peer)
-  (rt-del! rt
-           (subnet->bl subnet)
+  (define sub-bl (subnet->bl subnet))
+  (define existing (filter (compose (curry equal? peer) car) (rt-lookup rt sub-bl)))
+  (match existing
+    ;; disaggregation is necessary
+    [(cons fst _) #:when (not (equal? subnet (route-subnet (cdr fst))))
+                  ;; figure out how to disaggregate
+                  (define agg-route (cdr fst))
+                  (define new-subs (subnet-disaggregate (route-subnet agg-route) subnet))
+                  ;; delete agg route
+                  (rt-del! rt
+                           (subnet->bl (route-subnet agg-route))
+                           (lambda (el) (equal? el (cons peer agg-route))))
+                  ;; add new parts
+                  (for ([sub (in-list new-subs)])
+                    (rt-add! rt (subnet->bl sub)
+                             (cons peer (route-update-subnet agg-route sub))))]
+    ;; normal delete
+    [_ (rt-del! rt
+           sub-bl
            (lambda (el)
              (and (equal? (car el) peer)
-                  (equal? (route-subnet (cdr el)) subnet)))))
+                  (equal? (route-subnet (cdr el)) subnet))))]))
 
 ;; IP -> IP
 ;; Calculates our local IP on the subnet with peer p
 (define (peer-ip->own-ip p)
   (sub1 p))
 
+;; Route Subnet -> Route
+;; Changes the subnet for a route data object
+(define (route-update-subnet r s)
+  (struct-copy route r [subnet s]))
+
 ;; Route Route -> Bool
 ;; Checks if route r1 is "less than"/higher priority than r2 according to the specified rules
 (define (route< r1 r2)