marketplace-2014/drivers/udp.rkt

163 lines
5.9 KiB
Racket

#lang racket/base
;; UDP driver.
(require racket/set)
(require racket/match)
(require racket/udp)
(require "../sugar.rkt")
(provide (struct-out udp-remote-address)
(struct-out udp-handle)
(struct-out udp-listener)
udp-address?
udp-local-address?
(struct-out udp-packet)
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) #:transparent)
(struct udp-handle (id) #:transparent)
(struct udp-listener (port) #:transparent)
(define (udp-address? x)
(or (udp-remote-address? x)
(udp-handle? x)
(udp-listener? 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) #:transparent)
;; A HandleMapping is a record describing a mapping between a local
;; UdpAddress and its underlying UDP socket. It's private to the
;; implementation of the driver.
(struct handle-mapping (address socket) #:transparent)
;; TODO: BUG?: Routing packets between two local sockets won't work
;; because the patterns aren't set up to recognise that situation.
;; represents any remote address
;; any-remote : UdpAddressPattern
(define any-remote (udp-remote-address (wild) (wild)))
;; (define-type DriverState (Setof UdpLocalAddress))
;; (define-type SocketManagerState Boolean)
;; Process acting as a UDP socket factory.
;; udp-driver : (All (ParentState) -> (Spawn ParentState))
(define (udp-driver)
;; handle-presence : Topic DriverState -> (Transition DriverState)
(define (handle-presence topic active-handles)
(match-define (udp-packet _ (? udp-local-address? local-addr) _) topic)
(cond
[(set-member? active-handles local-addr)
(transition active-handles)]
[else
(transition (set-add active-handles local-addr)
(udp-socket-manager local-addr))]))
(name-process 'udp-driver
(spawn (transition (set)
(observe-subscribers (udp-packet any-remote (udp-handle (wild)) (wild))
(match-state active-handles
(match-conversation topic
(on-presence (handle-presence topic active-handles)))))
(observe-subscribers (udp-packet any-remote (udp-listener (wild)) (wild))
(match-state active-handles
(match-conversation topic
(on-presence (handle-presence topic active-handles)))))
(observe-publishers (udp-packet any-remote (udp-handle (wild)) (wild))
(match-state active-handles
(match-conversation topic
(on-presence (handle-presence topic active-handles)))))
(observe-publishers (udp-packet any-remote (udp-listener (wild)) (wild))
(match-state active-handles
(match-conversation topic
(on-presence (handle-presence topic active-handles)))))
(observe-publishers (handle-mapping (wild) (wild))
(match-state active-handles
(match-conversation (handle-mapping local-addr socket)
(on-absence
(transition (set-remove active-handles local-addr))))))
))))
;; bind-socket! : UDP-Socket UdpLocalAddress -> Void
(define (bind-socket! s local-addr)
(match local-addr
[(udp-listener port) (udp-bind! s #f port)]
[(udp-handle _) (udp-bind! s #f 0)]
[else (void)]))
;; valid-port-number? : Any -> Boolean : Natural
(define (valid-port-number? x)
;; Eventually TR will know about ranges
(exact-nonnegative-integer? x))
;; udp-socket-manager : UdpLocalAddress -> (Spawn DriverState)
(define (udp-socket-manager local-addr)
(define s (udp-open-socket #f #f))
(bind-socket! s local-addr)
(define buffer (make-bytes 65536)) ;; TODO: buffer size control
;; handle-absence : SocketManagerState -> (Transition SocketManagerState)
(define (handle-absence socket-is-open?)
(transition #f
(quit)
(when socket-is-open?
(name-process `(udp-socket-closer ,local-addr)
(spawn (begin (udp-close s)
(transition (void) (quit))))))))
(name-process `(udp-socket-manager ,local-addr)
(spawn (transition #t
;; Offers a handle-mapping on the local network so that
;; the driver/factory can clean up when this process dies.
(publisher (handle-mapping local-addr s))
;; If our counterparty removes either of their endpoints
;; as the subscriber end of the remote-to-local stream or
;; the publisher end of the local-to-remote stream, shut
;; ourselves down. Also, relay messages published on the
;; local-to-remote stream out on the actual socket.
(publisher (udp-packet any-remote local-addr (wild))
(match-state socket-is-open?
(on-absence (handle-absence socket-is-open?))))
(subscriber (udp-packet local-addr any-remote (wild))
(match-state socket-is-open?
(on-absence (handle-absence socket-is-open?))
(on-message
[(udp-packet (== local-addr)
(udp-remote-address remote-host remote-port)
body)
(begin (udp-send-to s remote-host remote-port body)
(transition socket-is-open?))])))
;; Listen for messages arriving on the actual socket using
;; a ground event, and relay them at this level.
(subscriber (cons (udp-receive!-evt s buffer) (wild))
(on-message
[(cons (? evt?) (list (? exact-integer? packet-length)
(? string? remote-host)
(? valid-port-number? remote-port)))
(let ((packet (subbytes buffer 0 packet-length)))
(send-message (udp-packet (udp-remote-address remote-host remote-port)
local-addr
packet)))]))))))