#lang racket/base
;; UDP drivers for os.rkt

(require racket/match)
(require racket/udp)
(require "dump-bytes.rkt")
(require "os-userland-stdlib.rkt")

(provide (struct-out udp-address)
	 (struct-out udp-packet)
	 udp-driver
	 udp-spy)

;; A UdpAddress is one of
;; -- a (udp-address String Uint16), representing a remote socket
;; -- a (udp-address #f Uint16), representing a local socket
(struct udp-address (host port) #:prefab)

;; A UdpPacket is a (udp-packet UdpAddress UdpAddress Bytes), and
;; represents a packet appearing on our local "subnet" of the full UDP
;; network, complete with source, destination and contents.
(struct udp-packet (source destination body) #:prefab)

;; TODO: BUG?: Routing packets between two local sockets won't work
;; because the patterns aren't set up to recognise that situation.

;; BootK
;; Process acting as a UDP socket factory.
(define udp-driver
  (userland
   (lambda ()
     (rpc-service
      [`(udp new ,port-number ,buffer-size)
       (define s (udp-open-socket #f #f))
       (when port-number
	 (udp-bind! s #f port-number))
       (define-values (_local-address local-port _remote-address _remote-port)
	 (udp-addresses s #t))
       (define sname (udp-address #f local-port))
       (spawn (userland (udp-sender sname s)))
       (spawn (userland (udp-receiver sname s buffer-size)))
       (spawn (userland (udp-closer sname s)))
       sname]))))

;; UdpAddress UdpSocket -> -> Void
;; Relays this-level UDP messages "originating" at the given sname
;; down to real Racket UDP send I/O actions on the given socket.
(define ((udp-sender sname s))
  (let loop ()
    (wait (message-handlers
	   [`(close ,(== sname))
	    (void)]
	   [(udp-packet (== sname) (udp-address host port) body)
	    (meta-send (lambda () (udp-send-to s host port body)))
	    (loop)]))))

;; UdpAddress UdpSocket Exact -> -> Void
;; Relays meta-level UDP messages arriving at the given socket up to
;; this-level UdpPacket messages with sink equal to the given
;; sname. Received packets are limited to the given buffer-size.
(define ((udp-receiver sname s buffer-size))
  (define buffer (make-bytes buffer-size))
  (let loop ()
    (wait (message-handlers
	   [`(close ,(== sname))
	    (void)])
	  (meta-message-handlers
	   [((list 'udp-receive sname)
	     (udp-receive!-evt s buffer)
	     => (list packet-length host port))
	    (define packet (subbytes buffer 0 packet-length))
	    (send (udp-packet (udp-address host port) sname packet))
	    (loop)]))))

;; UdpAddress UdpSocket -> -> Void
;; Waits for a (list 'close sname) message. When it gets one, closes
;; the socket. Note that the other socket-specific driver processes
;; are also listening for close messages of this form.
(define ((udp-closer sname s))
  (wait (message-handlers
	 [`(close ,(== sname))
	  (udp-close s)])))

;; BootK
;; Debugging aide: produces pretty hex dumps of UDP packets sent on
;; this network. Also prints out other messages without special
;; formatting.
(define udp-spy
  (userland
   (lambda ()
     (let loop ()
       (wait (message-handlers
	      [(udp-packet source dest body)
	       (write `(UDP ,source --> ,dest)) (newline)
	       (dump-bytes! body (bytes-length body))]
	      [x
	       (write `(UDP ,x)) (newline)]))
       (loop)))))