From e5c73f903056c7883350af040d252e0d089271ff Mon Sep 17 00:00:00 2001 From: haskal Date: Sat, 1 Feb 2020 23:55:14 -0500 Subject: [PATCH] Comments --- private/iputil.rkt | 31 +++++++++++++++++++++++++++++++ private/msg.rkt | 2 ++ private/radix-tree.rkt | 37 +++++++++++++++++++++++++++++++++++++ router | 28 +++++++++++++++++++++++++++- 4 files changed, 97 insertions(+), 1 deletion(-) diff --git a/private/iputil.rkt b/private/iputil.rkt index 1affb98..4ecbaa5 100644 --- a/private/iputil.rkt +++ b/private/iputil.rkt @@ -13,9 +13,19 @@ (require racket/struct) +;; Support functions for dealing with IP addresses, subnets, and peers + (module+ test (require rackunit)) +;; An IP is a Nat + +;; A PeerType is one of +;; - 'prov +;; - 'cust +;; - 'peer + +;; A Peer is a (peer IP PeerType) (struct peer [ip type] #:transparent #:methods gen:custom-write @@ -24,6 +34,7 @@ (lambda (x) 'peer) (lambda (x) (list (ip->string (peer-ip x)) (peer-type x)))))]) +;; A Subnet is a (subnet IP Nat) (struct subnet [ip mask] #:transparent #:methods gen:custom-write @@ -32,6 +43,8 @@ (lambda (x) 'subnet) (lambda (x) (list (subnet->string x)))))]) +;; Str -> IP +;; Parses the IP address contained in str (define (string->ip str) (define parts (reverse (string-split str "."))) (for/sum ([part (in-list parts)] @@ -39,6 +52,8 @@ (arithmetic-shift (string->number part) (* i 8)))) +;; IP -> Str +;; Serializes the IP address ip to a string (define (ip->string ip) (define parts (reverse (for/list ([i (in-range 4)]) @@ -46,33 +61,49 @@ 255))))) (string-join parts ".")) +;; IP -> Nat +;; Calculates how many mask bits are set in the given netmask represented as an IP address +;; Example: 255.0.0.0 -> 8 (define (ip-netmask ip) (- 32 (for/sum ([i (in-range 32)]) #:break (positive? (bitwise-and ip (arithmetic-shift 1 i))) 1))) +;; Nat -> IP +;; Creates an IP address representing the given netmask size +;; Example: 8 -> 255.0.0.0 (define (netmask-ip mask) (arithmetic-shift (sub1 (arithmetic-shift 1 mask)) (- 32 mask))) +;; Str -> Subnet +;; Parses a subnet from string (define (string->subnet str) (match-define (list ipstr maskstr) (string-split str "/")) (subnet (string->ip ipstr) (string->number maskstr))) +;; Subnet -> Str +;; Serializes a subnet to string (define (subnet->string sub) (format "~a/~a" (ip->string (subnet-ip sub)) (subnet-mask sub))) +;; Subnet -> [Listof Bool] +;; Converts a subnet into a list of booleans representing its bits (define (subnet->bl sub) (ip->bl (subnet-ip sub) (subnet-mask sub))) +;; IP -> [Listof Bool] +;; Converts an IP address into a list of booleans representing its bits (define (ip->bl ip [bits 32]) (for/list ([i (in-range bits)]) (= 1 (bitwise-and 1 (arithmetic-shift ip (- i 31)))))) +;; Str -> Peer +;; Parses a peer from string (define (string->peer str) (match-define (list ip type) (string-split str "-")) (peer (string->ip ip) (string->symbol type))) diff --git a/private/msg.rkt b/private/msg.rkt index c857c13..8dc194f 100644 --- a/private/msg.rkt +++ b/private/msg.rkt @@ -4,6 +4,8 @@ (require json "iputil.rkt") +;; Types and helper functions for router messages + (module+ test (require rackunit)) diff --git a/private/radix-tree.rkt b/private/radix-tree.rkt index e3d60b6..d39f51e 100644 --- a/private/radix-tree.rkt +++ b/private/radix-tree.rkt @@ -4,11 +4,24 @@ (provide make-rt rt-update! 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. + +;; An RT is a (rt-node RTedge RTedge Any) +;; An RTkey is a [Listof Bool] +;; An RTedge is a (rt-edge RTkey RT) (struct rt-node [edge0 edge1 data] #:transparent #:mutable) +;; Edge labels always contain all of their bits, even though the first bit is redundant +;; (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)) @@ -16,12 +29,25 @@ (define (rt-getter bit) (if bit rt-node-edge1 rt-node-edge0)) (define (rt-setter bit) (if bit set-rt-node-edge1! set-rt-node-edge0!)) +;; RTkey RTkey -> Nat +;; Computes the length of the longest common prefix in bl1 and bl2 (define (bl-common-len bl1 bl2) (for/sum ([b1 (in-list bl1)] [b2 (in-list bl2)]) #:break (not (equal? b1 b2)) 1)) +;; An RTresult is one of +;; (list 'exact RT) - An exact match for the given key that landed on the returned RT +;; (list 'partial RT RTedge Nat RTkey [Listof RT]) - A partial match stopping at the given +;; RT, next partially matched edge, length of partial match, tail of the key not exactly +;; matched, and a list of visited nodes ordered by most recent first +;; (list 'no-match RT RTkey [Listof RT]) - No match was found, but we stopped at the given +;; RT, with tail of the key that did not match, and list of visited nodes ordered by most +;; recent first + +;; RT RTkey [[Listof RT]] -> RTresult +;; Helper function that performs tree iteration (define (rt-partial-iterate node key [visited '()]) (cond [(empty? key) (list 'exact node)] @@ -38,6 +64,9 @@ [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) (define (insert-node! node key) (let* ([bit (first key)] @@ -69,6 +98,9 @@ [(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)] @@ -82,6 +114,8 @@ [(list _ ... visited) 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)] @@ -103,6 +137,9 @@ ; (test-insert! "0011") ; (test-insert! "0000") +;; RT [Str] -> +;; Debug print function that dumps the tree to current-output-port in a vaguely human-readable +;; format (define (rt-dump node [prefix ""]) (displayln (format "~a node ~a" prefix (rt-node-data node))) (define edge0 (rt-node-edge0 node)) diff --git a/router b/router index 258303f..43c2f9e 100755 --- a/router +++ b/router @@ -3,6 +3,13 @@ ; vim:syntax=racket ; vim:ft=racket +; __ __ __ +; __/ // /_/ /___ _____ ____ _ __ ___ ____ __ +; /_ _ __/ / __ `/ __ \/ __ `/ / / / / | /| / / / / / +; /_ _ __/ / /_/ / / / / /_/ / / /_/ /| |/ |/ / /_/ / +; /_//_/ /_/\__,_/_/ /_/\__, / \__,_/ |__/|__/\__,_/ +; /____/ + (require json "private/iputil.rkt" "private/unix-socket.rkt" @@ -23,6 +30,7 @@ (make-rt)) ;; Router Route Peer -> Void +;; Adds route r from peer to the routing database (define (router-add! rt r peer) (rt-update! rt (subnet->bl (route-subnet r)) @@ -30,9 +38,12 @@ (lambda () '()))) ;; IP -> IP +;; Calculates our local IP on the subnet with peer p (define (peer-ip->own-ip p) (sub1 p)) +;; Route Route -> Bool +;; Checks if route r1 is "less than"/higher priority than r2 according to the specified rules (define (route< r1 r2) #| (route< r1 r2) iff "r1 wins" @@ -58,6 +69,7 @@ (error "your router is angery..."))) ;; 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) @@ -68,7 +80,7 @@ [_ #f])) ;; Router -> Msg -;; Dumps routing table +;; 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 @@ -78,6 +90,9 @@ (route-nexthop (cdr route)))) routes))))) +;; Peer Route Int -> Msg +;; Creates an update message based on a received update message r that we can forward to other +;; routers (define (router-format-update peer r asn) ;; Route -> Route (define (update-aspath r asn) @@ -91,6 +106,7 @@ ;; -- ;; Runs router logic, given a list of peer connections. (define (run-router/conns asn peer-conns) + ;; This channel collects messages from every peer connection (define mail (make-channel)) @@ -106,11 +122,15 @@ (channel-put mail (list peer msg)) (loop)))))) + ;; IP -> Peer + ;; Looks up a peer based on their IP (define (ip->peer ip) (findf (λ (peer) (equal? ip (peer-ip peer))) (map peer-conn-info peer-conns))) + ;; Peer -> Peer-Conn + ;; Looks up a peer connection based on a peer object (define (peer->peer-conn peer) (findf (λ (pc) (equal? peer (peer-conn-info pc))) @@ -120,6 +140,11 @@ (make-router)) (let loop () + ;; Main router loop + ;; - Get next message + ;; - Generate some messages to send out, maybe + ;; - Send out those messages + (match-define (list src-peer msg) (channel-get mail)) (printf "====\nfrom ~a:\n~s\n" src-peer msg) @@ -180,6 +205,7 @@ sock-in sock-out))))) +;; Parse command line arguments and start router (module+ main (command-line #:program "router"