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

;; 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)
    (match msg

      [(msg:update src dst r)
       (router-add! router
                    r
                    (ip->peer src))
       (rt-dump router)]

      [(msg:data src dst data)
       (define-values [dst-peer-conn resp-msg]
         (match (router-find-best router dst)
           [#f
            (values src-peer-conn
                    (msg:no-route src dst))]
           [dst-peer
            (values (peer->peer-conn dst-peer)
                    msg)]))
       (printf "----\nwant to send back to ~a:\n~a\n"
               (peer-conn-info dst-peer-conn)
               resp-msg)]

      [_
       (printf "----\nignored\n")])
    (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)))