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
(define (router-add! rt r peer)
  (rt-update! rt
              (subnet->bl (route-subnet r))
              (lambda (rst) (cons (cons peer r) rst))
              (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"

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

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

;; 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)))
           (cons pc (router-format-update (peer-conn-info pc) r asn)))]

        [(msg:data src dst data)
         (match (router-find-best router dst)
           [#f
            (list (cons (peer->peer-conn src-peer)
                        (msg:no-route (peer-ip->own-ip src)
                                      src)))]
           [dst-peer
            (list (cons (peer->peer-conn dst-peer)
                        msg))])]
        [(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)))