CS3700-project2/router

#!/usr/bin/env racket
#lang racket
; vim:syntax=racket
; vim:ft=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 () '())))

;; IP -> IP
(define (peer-ip->own-ip p)
  (sub1 p))

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

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

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