diff --git a/minimart/drivers/udp.rkt b/minimart/drivers/udp.rkt new file mode 100644 index 0000000..e96753e --- /dev/null +++ b/minimart/drivers/udp.rkt @@ -0,0 +1,92 @@ +#lang racket/base + +(require racket/match) +(require (prefix-in udp: racket/udp)) +(require "../main.rkt") +(require "../demand-matcher.rkt") + +(provide (struct-out udp-remote-address) + (struct-out udp-handle) + (struct-out udp-listener) + udp-address? + udp-local-address? + (struct-out udp-packet) + spawn-udp-driver) + +;; A UdpAddress is one of +;; -- a (udp-address String Uint16), representing a remote socket +;; -- a (udp-handle Any), representing a local socket on a kernel-assigned port +;; -- a (udp-listener Uint16), representing a local socket on a user-assigned port +;; Note that udp-handle-ids must be chosen carefully: they are scoped +;; to the local VM, i.e. shared between processes in that VM, so +;; processes must make sure not to accidentally clash in handle ID +;; selection. +(struct udp-remote-address (host port) #:prefab) +(struct udp-handle (id) #:prefab) +(struct udp-listener (port) #:prefab) + +(define (udp-address? x) + (or (udp-remote-address? x) + (udp-local-address? x))) + +(define (udp-local-address? x) + (or (udp-handle? x) + (udp-listener? x))) + +;; 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) + +;; -> Action +;; Spawns a process acting as a UDP socket factory. +(define (spawn-udp-driver) + (list + (spawn-demand-matcher (udp-packet ? (?! (udp-listener ?)) ?) + #:demand-is-subscription? #t + spawn-udp-socket) + (spawn-demand-matcher (udp-packet ? (?! (udp-handle ?)) ?) + #:demand-is-subscription? #t + spawn-udp-socket))) + +;; UdpLocalAddress -> Action +(define (spawn-udp-socket local-addr) + (define socket (udp:udp-open-socket #f #f)) + + (match local-addr + [(udp-listener port) (udp:udp-bind! socket #f port)] + [(udp-handle _) (udp:udp-bind! socket #f 0)]) ;; kernel-allocated port number + + (define control-ch (make-channel)) + (thread (lambda () (udp-receiver-thread local-addr socket control-ch))) + + (spawn (lambda (e s) + (match e + [(routing-update g) + (transition s (when (gestalt-empty? g) (quit)))] + [(message (? udp-packet? p) 1 #f) + (transition s (send p))] + [(message (udp-packet _ (udp-remote-address host port) body) 0 #f) + (udp:udp-send-to socket host port body) + #f] + [_ #f])) + (void) + (gestalt-union (sub (udp-packet ? local-addr ?) #:meta-level 1) + (sub (udp-packet local-addr (udp-remote-address ? ?) ?)) + (pub (udp-packet (udp-remote-address ? ?) local-addr ?)) + (pub (udp-packet (udp-remote-address ? ?) local-addr ?) #:level 1)))) + +;; UdpLocalAddress UdpSocket Channel -> Void +(define (udp-receiver-thread local-addr socket control-ch) + (define buffer (make-bytes 65536)) + (let loop () + (sync (handle-evt control-ch (match-lambda ['quit (void)])) + (handle-evt (udp:udp-receive!-evt socket buffer) + (lambda (receive-results) + (match-define (list len source-hostname source-port) receive-results) + (send-ground-message + (udp-packet (udp-remote-address source-hostname source-port) + local-addr + (subbytes buffer 0 len))) + (loop))))) + (udp:udp-close socket)) diff --git a/minimart/examples/udp-hello.rkt b/minimart/examples/udp-hello.rkt new file mode 100644 index 0000000..4b6bc3e --- /dev/null +++ b/minimart/examples/udp-hello.rkt @@ -0,0 +1,16 @@ +#lang minimart + +(require "../drivers/udp.rkt") + +(spawn-udp-driver) + +(spawn (lambda (e s) + (match e + [(message (udp-packet src dst body) _ _) + (log-info "Got packet from ~v: ~v" src body) + (transition s (send (udp-packet dst + src + (string->bytes/utf-8 (format "You said: ~a" body)))))] + [_ #f])) + (void) + (gestalt-union (sub (udp-packet ? (udp-listener 5999) ?))))