syndicate-rkt/syndicate/drivers/udp.rkt

102 lines
3.7 KiB
Racket

;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
#lang syndicate
(provide (struct-out udp-remote-address)
(struct-out udp-handle)
(struct-out udp-listener)
(struct-out udp-multicast-group-member)
(struct-out udp-multicast-loopback)
udp-address?
udp-local-address?
(struct-out udp-packet))
(require (prefix-in udp: racket/udp))
;; A UdpAddress is one of
;; -- a (udp-remote-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 dataspace, i.e. shared between processes in that
;; dataspace, so processes must make sure not to accidentally clash in
;; handle ID selection.
(struct udp-remote-address (host port) #:prefab)
(struct udp-handle (id) #:prefab)
(struct udp-listener (port) #:prefab)
(define (udp-address? x)
(or (udp-remote-address? x)
(udp-local-address? x)))
(define (udp-local-address? x)
(or (udp-handle? x)
(udp-listener? x)))
;; A UdpMembership is a (udp-multicast-group-member UdpLocalAddress String String),
;; where the latter two arguments correspond to the last two arguments
;; of `udp-multicast-join-group!`.
(assertion-struct udp-multicast-group-member (local-address group-address interface))
;; A UdpLoopback is a (udp-multicast-loopback UdpLocalAddress Boolean).
(assertion-struct udp-multicast-loopback (local-address enabled?))
;; 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.
(message-struct udp-packet (source destination body))
(spawn #:name 'udp-driver
(during/spawn (observe ($ local-addr (udp-listener _)))
#:name local-addr
(udp-main local-addr))
(during/spawn (observe ($ local-addr (udp-handle _)))
#:name local-addr
(udp-main local-addr)))
;; UdpLocalAddress -> Void
(define (udp-main local-addr)
(define socket (udp:udp-open-socket #f #f))
(match local-addr
[(udp-listener port) (udp:udp-bind! socket #f port #t)]
[(udp-handle _) (udp:udp-bind! socket #f 0)]) ;; kernel-allocated port number
(define control-ch (make-channel))
(thread (lambda () (udp-receiver-thread local-addr socket control-ch)))
(signal-background-activity! +1)
(on-stop (channel-put control-ch 'quit))
(assert local-addr)
(stop-when (retracted (observe local-addr)))
(during (udp-multicast-group-member local-addr $group $interface)
(on-start (udp:udp-multicast-join-group! socket group interface))
(on-stop (udp:udp-multicast-leave-group! socket group interface)))
(on (asserted (udp-multicast-loopback local-addr $enabled))
(udp:udp-multicast-set-loopback! socket enabled))
(on (message (inbound ($ p (udp-packet _ local-addr _))))
(send! p))
(on (message (udp-packet local-addr (udp-remote-address $h $p) $body))
(udp:udp-send-to* socket h p body)))
;; UdpLocalAddress UdpSocket Channel -> Void
(define (udp-receiver-thread local-addr socket control-ch)
(define buffer (make-bytes 65536))
(let loop ()
(sync (handle-evt control-ch (match-lambda ['quit (void)]))
(handle-evt (udp:udp-receive!-evt socket buffer)
(lambda (receive-results)
(match-define (list len source-hostname source-port) receive-results)
(ground-send!
(udp-packet (udp-remote-address source-hostname source-port)
local-addr
(subbytes buffer 0 len)))
(loop)))))
(udp:udp-close socket)
(signal-background-activity! -1))