CS3700-project2/router

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

(require json
         "iputil.rkt"
         "unix-socket.rkt"
         "msg.rkt"
         "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
(define (router-add! rt r peer)
  (rt-update! rt
              (subnet->bl (route-subnet r))
              (lambda (rst) (cons (cons peer r) rst))
              (lambda () '())))

(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) 1 0)))
      (cmp (compose length route-as-path))
      (cmp (lambda (x) (match (route-origin x) ['IGP 3] ['EGP 2] ['UNK 1])))
      (cmp route-nexthop)
      (error "your router is angery...")))

;; Router IP -> (U Peer #f)
(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
;; Dumps routing table
(define (router-dump rt src dst)
    (msg:table (sub1 src) src
               (map (lambda (route) (list (route-subnet route) (route-nexthop route)))
                    (rt-flatten rt))))

;; Str [Listof Peer-Conn] -> Void
;; --
;; Runs router logic, given a list of peer connections.
(define (run-router/conns ans peer-conns)
  (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))))))

  (define (ip->peer ip)
    (findf (λ (peer)
             (equal? ip (peer-ip peer)))
           (map peer-conn-info peer-conns)))

  (define (peer->peer-conn peer)
    (findf (λ (pc)
             (equal? peer (peer-conn-info pc)))
           peer-conns))

  (define router
    (make-router))

  (let loop ()
    (match-define (list src-peer-conn msg) (channel-get mail))
    (printf "====\nfrom ~a:\n~s\n" src-peer-conn 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? pc src-peer-conn)))
           (cons pc msg))]

        [(msg:data src dst data)
         (match (router-find-best router dst)
           [#f
            (list (cons src-peer-conn
                        (msg:no-route (sub1 src)
                                      src)))]
           [dst-peer
            (list (cons (peer->peer-conn dst-peer)
                        msg))])]

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

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

(module+ main
  (command-line
   #:program "router"
   #:args
   (asn . peers)
   (with-output-to-file "log.txt"
     #:exists 'replace
     (λ ()
       ;; Run the router
       (run-router 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)))