#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. (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])))) (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)])))) (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)])))) (define ((udp-closer sname s)) (wait (message-handlers [`(close ,(== sname)) (udp-close s)]))) (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)))))