hash-lang-uwu
/
CS3700-project2
2
0
Fork 0
Code Issues Releases Activity

simplify radix-tree to map keys to lists of data

This commit is contained in:
Milo Turner 2020-02-14 16:22:06 -05:00
parent fc7593c32d
commit 178a225baa
2 changed files with 82 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
private/radix-tree.rkt
View File

@ -2,14 +2,13 @@
(require "iputil.rkt")
(provide make-rt rt-update! rt-lookup rt-dump rt-flatten)
(provide make-rt rt-add! rt-del! rt-lookup rt-dump rt-flatten)
;; Radix tree implementation for efficient routing lookups
;; This module provides a radix tree type indexed by bit-lists (lists of booleans representing IP
;; address bits), which supports arbitary node data at any tree depth. Lookup always find the most
;; specific match.
;; address bits), which supports arbitary node data at any tree depth. Lookup finds all the matches.
;; An RT is a (rt-node RTedge RTedge Any)
;; An RT is a (rt-node RTedge RTedge [Listof Any])
;; An RTkey is a [Listof Bool]
;; An RTedge is a (rt-edge RTkey RT)
(struct rt-node [edge0 edge1 data] #:transparent #:mutable)
@ -17,13 +16,10 @@
;; (represented by whether this was an edge0 or edge1 in the parent node)
(struct rt-edge [label target] #:transparent)
;; A unique symbol representing no data associated with a certain node
(define empty-node-data '()) ;(gensym 'MEOW)
;; -> RT
;; Creates a new empty RT
(define (make-rt)
(rt-node #f #f empty-node-data))
(rt-node #f #f '()))
;; Helper functions for rt-node struct access based on whether the edge is 1 or 0
(define (rt-getter bit) (if bit rt-node-edge1 rt-node-edge0))
@ -64,14 +60,13 @@
[next-edge (list 'partial node next-edge next-common-len key (cons node visited))]
[else (list 'no-match node key (cons node visited))]))]))
;; RT RTkey (Any -> Any) (-> Any)
;; Updates the radix tree for the given key, using updater and failure-result like the standard
;; racket -update! abstraction
(define (rt-update! node key updater failure-result)
;; RT RTkey Any -> Void
;; Updates the radix tree for the given key, adding the elem to the data at that key.
(define (rt-add! node key elem)
(define (insert-node! node key)
(let* ([bit (first key)]
[setter! (rt-setter bit)])
(setter! node (rt-edge key (rt-node #f #f (updater (failure-result)))))))
(setter! node (rt-edge key (rt-node #f #f (list elem))))))
(define (split-node! node key orig-edge prefix-len)
(let* ([bit (first key)]
[setter! (rt-setter bit)]
@ -82,54 +77,52 @@
(let* ([next-bit (list-ref orig-label prefix-len)]
[common-node (rt-node (if next-bit #f new-orig-edge)
(if next-bit new-orig-edge #f)
(updater (failure-result)))]
(list elem))]
[common-edge (rt-edge (take key prefix-len) common-node)])
(setter! node common-edge))
(let* ([new-insert-edge (rt-edge (drop key prefix-len)
(rt-node #f #f (updater (failure-result))))]
(rt-node #f #f (list elem)))]
[diff-bit (list-ref key prefix-len)]
[common-node (rt-node (if diff-bit new-orig-edge new-insert-edge)
(if diff-bit new-insert-edge new-orig-edge)
empty-node-data)]
'())]
[common-edge (rt-edge (take key prefix-len) common-node)])
(setter! node common-edge)))))
(match (rt-partial-iterate node key)
[(list 'exact node)
(set-rt-node-data!
node
(let ([d (rt-node-data node)])
(updater
(if (eq? d empty-node-data) (failure-result) d))))]
(set-rt-node-data! node
(cons elem (rt-node-data node)))]
[(list 'partial node orig-edge prefix-len partial-key visited)
(split-node! node partial-key orig-edge prefix-len)]
[(list 'no-match node partial-key visited)
(insert-node! node partial-key)]))
;; RT RTkey (-> Any) -> Any
;; Looks up the most specific match for the given key in the tree, using failure-result if nothing
;; was found
(define (rt-lookup node key failure-result)
(define (find-first-with-data nodes)
(or (for/first ([node (in-list nodes)]
#:when (not (eq? empty-node-data (rt-node-data node))))
(rt-node-data node))
(failure-result)))
(find-first-with-data
;; RT RTKey (Any -> Boolean) -> Void
;; 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 _ ... visited) visited]))])
(set-rt-node-data! node
(filter (negate del?)
(rt-node-data node)))))
;; RT RTkey -> [Listof Any]
;; Looks up all the matches for the given key in the tree, ordered from most-specific to
;; least-specific.
(define (rt-lookup node key)
(match (rt-partial-iterate node key)
[(list 'exact node)
(list node)]
[(list _ ... visited)
visited])))
[(list 'exact node) (rt-node-data node)]
[(list _ ... visited) (append-map rt-node-data visited)]))
;; RT -> [Listof Any]
;; Converts the tree into a flat list of all contained node data
(define (rt-flatten node)
(define (flatten-edge e) (if e (rt-flatten (rt-edge-target e)) '()))
(let* ([e1 (rt-node-edge0 node)]
[e2 (rt-node-edge1 node)]
[data (rt-node-data node)]
[rst (apply append (map flatten-edge (list e1 e2)))])
(if (equal? data empty-node-data) rst (cons data rst))))
(define (flatten-edge e)
(if e (rt-flatten (rt-edge-target e)) '()))
(append (rt-node-data node)
(flatten-edge (rt-node-edge0 node))
(flatten-edge (rt-node-edge1 node))))
;; RT [Str] ->
;; Debug print function that dumps the tree to current-output-port in a vaguely human-readable
@ -145,27 +138,30 @@
(displayln (format "~a edge1 ~a" prefix (rt-edge-label edge1)))
(rt-dump (rt-edge-target edge1) (string-append prefix " "))))
(define test (make-rt))
(define (str->bl x)
(map (curry equal? #\1) (string->list x)))
(define (test-insert! x)
(rt-update!
test
(str->bl x)
(lambda (_) x)
(lambda () x)))
; (test-insert! "0001")
; (test-insert! "")
; (rt-dump test)
; (test-insert! "0001")
; (test-insert! "000")
; (test-insert! "0")
; (rt-dump test)
; (rt-partial-iterate test (str->bl "0001"))
; (rt-lookup test (str->bl "0000") (lambda () (error "bad")))
; (test-insert! "0001")
; (test-insert! "1000")
; (test-insert! "1010")
; (test-insert! "0011")
; (test-insert! "0000")
(module+ test
(define (str->bl x)
(map (curry equal? #\1) (string->list x)))
(define test (make-rt))
(define (test-insert! x)
(rt-add! test (str->bl x) x))
(test-insert! "0001")
(test-insert! "")
(rt-dump test)
(test-insert! "0001")
(test-insert! "000")
(test-insert! "0")
(rt-dump test)
(rt-partial-iterate test (str->bl "0001"))
(rt-lookup test (str->bl "0000"))
; (test-insert! "0001")
; (test-insert! "1000")
; (test-insert! "1010")
; (test-insert! "0011")
; (test-insert! "0000")
)

43
router
View File

@ -34,30 +34,25 @@
(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
[(member (cons peer flipped-route)
(rt-lookup rt flipped-bl))
(define r* (struct-copy route r [subnet (subnet-drop-last (route-subnet r))]))
(rt-del! rt flipped-bl (curry equal? (cons peer flipped-route)))
(router-add! rt r* peer)]
[else
(rt-add! rt
(subnet->bl (route-subnet r))
(lambda (rst) (cons (cons peer r) rst))
(lambda () '()))]))
(cons peer r))]))
;; Router Route Peer -> Void
;; Tries to find the given route and removes it from the routing database
(define (router-revoke! rt subnet peer)
;; [Listof [Cons Peer Route]] -> [Listof [Cons Peer Route]]
;; Removes route r from the given list, if present
(define (remove-route routes)
(filter (lambda (el) (not (and (equal? (car el) peer)
(equal? (route-subnet (cdr el)) subnet))))
routes))
(rt-update! rt
(rt-del! rt
(subnet->bl subnet)
(lambda (lst) (remove-route lst))
(lambda () '())))
(lambda (el)
(and (equal? (car el) peer)
(equal? (route-subnet (cdr el)) subnet)))))
;; IP -> IP
;; Calculates our local IP on the subnet with peer p
@ -83,6 +78,7 @@
[y2 (mapper r2)])
(cond [(< x2 y2) (meow #t)]
[(> x2 y2) (meow #f)])))
(cmp (compose - subnet-mask route-subnet))
(cmp (compose - route-pref))
(cmp (lambda (x) (if (route-self-origin? x) 0 1)))
(cmp (compose length route-as-path))
@ -93,9 +89,7 @@
;; Router IP -> (U Peer #f)
;; Finds the most specific route for the given IP
(define (router-find-best rt src-ip)
(match (sort (rt-lookup rt
(ip->bl src-ip)
(λ () '()))
(match (sort (rt-lookup rt (ip->bl src-ip))
route<
#:key cdr)
[(list* (cons peer _) _) peer]
@ -104,13 +98,10 @@
;; Router -> Msg
;; Creates a table message with a dump of the current routing table
(define (router-dump rt src dst)
(define routing-table (rt-flatten rt))
(msg:table (peer-ip->own-ip src) src
(for/fold ([entries '()]) ([routes (in-list routing-table)])
(append entries (map (lambda (route)
(list (route-subnet (cdr route))
(route-nexthop (cdr route))))
routes)))))
(for/list ([el (in-list (rt-flatten rt))])
(list (route-subnet (cdr el))
(route-nexthop (cdr el))))))
;; Peer Route Int -> Msg
;; Creates an update message based on a received update message r that we can forward to other