75 lines
2.2 KiB
Racket
75 lines
2.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)
|
|
|
|
;; 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 sname (udp-address #f port-number))
|
|
(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 ()
|
|
(printf "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~n~v~n" body)
|
|
(dump-bytes! body (bytes-length body))
|
|
(flush-output)
|
|
(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))
|
|
(printf ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>~n~v~n" packet)
|
|
(dump-bytes! buffer packet-length)
|
|
(flush-output)
|
|
(send (udp-packet (udp-address host port) sname packet))
|
|
(loop)]))))
|
|
|
|
(define ((udp-closer sname s))
|
|
(wait (message-handlers
|
|
[`(close ,(== sname))
|
|
(udp-close s)])))
|