CS3700-project2/router

#!/usr/bin/env racket
#lang racket
; vim:ft=racket

;      __ __  __
;   __/ // /_/ /___ _____  ____ _   __  ___      ____  __
;  /_  _  __/ / __ `/ __ \/ __ `/  / / / / | /| / / / / /
; /_  _  __/ / /_/ / / / / /_/ /  / /_/ /| |/ |/ / /_/ /
;  /_//_/ /_/\__,_/_/ /_/\__, /   \__,_/ |__/|__/\__,_/
;                       /____/

(require "private/iputil.rkt"
         "private/unix-socket.rkt"
         "private/msg.rkt"
         "private/radix-tree.rkt")

;; info : Peer
;; sock-in : Input-Port
;; sock-out : Output-Port
(struct peer-conn
  [info sock-in sock-out]
  #:transparent)

;; a Router is a [RTof [Listof [Cons Peer Route]]]

;; -> Router
(define (make-router)
  (make-rt))

;; 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)
  (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]))
  (cond
    [(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))
              (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)
  (rt-del! rt
           (subnet->bl subnet)
           (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
(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"

      1. The path with the highest "localpref" wins. If the "localpref"s are equal...
      2. The path with "selfOrigin" = true wins. If all selfOrigins are the equal...
      3. The path with the shortest "ASPath" wins. If multiple routes have the shortest length...
      4. The path with the best "origin" wins, were IGP > EGP > UNK.
         If multiple routes have the best origin...
      5. The path from the neighbor router with the lowest IP address.
  |#
  (let/ec meow
      (define (cmp mapper)
        (let ([x2 (mapper r1)]
              [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))
      (cmp (lambda (x) (match (route-origin x) ['IGP 1] ['EGP 2] ['UNK 3])))
      (cmp route-nexthop)
      (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))
               route<
               #:key cdr)
    [(list* (cons peer _) _) peer]
    [_ #f]))

;; Router -> Msg
;; Creates a table message with a dump of the current routing table
(define (router-dump rt src dst)
  (msg:table (peer-ip->own-ip src) src
             (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
;; routers
(define (router-format-update peer r asn)
  ;; Route -> Route
  (define (update-aspath r asn)
    (struct-copy route r [as-path (append (route-as-path r) (list asn))]))
  (msg:update
    (peer-ip->own-ip (peer-ip peer))
    (peer-ip peer)
    (update-aspath r asn)))

;; Peer Peer -> Bool
;; Checks if we should send a route update from the given src peer to the dst peer
(define (router-should-update? src-peer dst-peer)
  (match (peer-type src-peer)
    ['cust #t]
    [_ (symbol=? 'cust (peer-type dst-peer))]))

;; Int [Listof Peer-Conn] -> Void
;; --
;; 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))

  (define peer-threads
    (for/list ([pc (in-list peer-conns)])
      (match-define (peer-conn peer sock-in sock-out) pc)
      (thread (λ ()
                (define buf (make-bytes 65536))
                (let loop ()
                  (define len (read-bytes-avail! buf sock-in))
                  (printf "got ~a bytes from ~a...\n" len peer)
                  (define msg (bytes->msg (subbytes buf 0 len)))
                  (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)))
           peer-conns))

  (define router
    (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)

    ;; [Listof [Cons Peer-Conn Msg]]
    (define to-send
      (match msg

        [(msg:update src dst r)
         (router-add! router
                      r
                      (ip->peer src))
         (rt-dump router)
         (for/list ([pc (in-list peer-conns)]
                    #:when (not (eq? (peer-conn-info pc) src-peer))
                    #:when (router-should-update? src-peer (peer-conn-info pc)))
           (cons pc (router-format-update (peer-conn-info pc) r asn)))]

        [(msg:revoke src dst networks)
         (for ([net (in-list networks)]) (router-revoke! router net (ip->peer src)))
         (rt-dump router)
         (for/list ([pc (in-list peer-conns)]
                     #:when (not (eq? (peer-conn-info pc) src-peer))
                     #:when (router-should-update? src-peer (peer-conn-info pc)))
           (let ([pip (peer-ip (peer-conn-info pc))])
             (cons pc (msg:revoke (peer-ip->own-ip pip) pip networks))))]

        [(msg:data src dst data)
         (match (router-find-best router dst)
           [(? peer? dst-peer) #:when (ormap (compose (curry symbol=? 'cust) peer-type)
                                             (list dst-peer src-peer))
            (list (cons (peer->peer-conn dst-peer)
                        msg))]
           [_
            (list (cons (peer->peer-conn src-peer)
                        (msg:no-route (peer-ip->own-ip (peer-ip src-peer))
                                      src)))])]
        [(msg:dump src dst)
         (list (cons (peer->peer-conn src-peer) (router-dump router src dst)))]
        [_
         (printf "----\nignored\n")
         '()]))

    (for ([dst+msg (in-list to-send)])
      (match-define (cons dst-peer-conn resp-msg) dst+msg)
      (printf "----\nwant to send to ~a:\n~a\n"
              (peer-conn-info dst-peer-conn)
              resp-msg)
      (define dst-port
        (peer-conn-sock-out dst-peer-conn))
      (write-bytes (msg->bytes resp-msg) dst-port)
      (flush-output dst-port))

    (loop)))

;; Int [Listof Peer] ->
;; Router main
(define (run-router asn peers)
  (displayln asn)
  (map displayln peers)
  (displayln "------------")
  (with-handlers ([exn:break? (λ (e) (printf "time to die.\n"))])
    (run-router/conns
     asn
     (for/list ([peer (in-list peers)])
       (define-values [sock-in sock-out]
         (unix-socket-connect (ip->string (peer-ip peer))
                              'SOCK-SEQPACKET))
       (peer-conn peer
                  sock-in
                  sock-out)))))

;; Parse command line arguments and start router
(module+ main
  (command-line
   #:program "router"
   #:args
   (asn . peers)
   (with-output-to-file "log.txt"
     #:exists 'replace
     (λ ()
       ;; Run the router
       (run-router (string->number asn) (map string->peer peers))))))

(module+ test

  (define-values [in1 out1] (make-pipe))
  (define-values [in2 out2] (make-pipe))
  (define p1 (peer-conn (string->peer "1.2.3.4-cust") in1 out1))
  (define p2 (peer-conn (string->peer "1.2.3.5-peer") in2 out2))

;  (define abort-router
    (run-router/conns "123"
                      (list p1 p2))

  (void
   (write-string "{\"a\": 1, \"b\": [1,2,3]}" out1)))