99 lines
3.2 KiB
Racket
99 lines
3.2 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.
|
|
|
|
;; 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)))))
|