racket-matrix-2012/os-udp.rkt

83 lines
2.4 KiB
Racket

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