syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

UDP.

This commit is contained in:
Tony Garnock-Jones 2016-01-23 21:59:33 -05:00
parent 6a449648e3
commit aabeb5adcd
3 changed files with 64 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
main.rkt
View File

@ -7,7 +7,7 @@
(require "arp.rkt") (require "arp.rkt")
(require "ip.rkt") (require "ip.rkt")
;; (require "tcp.rkt") ;; (require "tcp.rkt")
;; (require "udp.rkt") (require "udp.rkt")
;;(log-events-and-actions? #t) ;;(log-events-and-actions? #t)
@ -16,7 +16,7 @@
(spawn-arp-driver) (spawn-arp-driver)
(spawn-ip-driver) (spawn-ip-driver)
;; (spawn-tcp-driver) ;; (spawn-tcp-driver)
;; (spawn-udp-driver) (spawn-udp-driver)
(spawn-demo-config) (spawn-demo-config)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -66,7 +66,7 @@
spawn-session) spawn-session)
) )
#;(let () (let ()
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(message (udp-packet src dst body)) [(message (udp-packet src dst body))

11
port-allocator.rkt
View File

@ -16,12 +16,12 @@
(define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports) (define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports)
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(routing-update g) [(scn g)
(define local-ips (or (gestalt->local-ip-addresses g) (set))) (define local-ips (or (gestalt->local-ip-addresses g) (set)))
(define new-used-ports (compute-used-ports g local-ips)) (define new-used-ports (compute-used-ports g local-ips))
(log-info "port-allocator ~v used ports: ~v" allocator-type new-used-ports) (log-info "port-allocator ~v used ports: ~v" allocator-type new-used-ports)
(transition (port-allocator-state new-used-ports local-ips) '())] (transition (port-allocator-state new-used-ports local-ips) '())]
[(message (port-allocation-request _ k) _ _) [(message (port-allocation-request _ k))
(define currently-used-ports (port-allocator-state-used-ports s)) (define currently-used-ports (port-allocator-state-used-ports s))
(let randomly-allocate-until-unused () (let randomly-allocate-until-unused ()
(define p (+ 1024 (random 64512))) (define p (+ 1024 (random 64512)))
@ -32,7 +32,6 @@
(k p (port-allocator-state-local-ips s)))))] (k p (port-allocator-state-local-ips s)))))]
[_ #f])) [_ #f]))
(port-allocator-state (set) (set)) (port-allocator-state (set) (set))
(apply gestalt-union (scn/union (subscription (port-allocation-request allocator-type ?))
(sub (port-allocation-request allocator-type ?)) observe-local-ip-addresses-gestalt
observe-local-ip-addresses-gestalt observer-gestalt)))
observer-gestalt)))

112
udp.rkt
View File

@ -43,6 +43,7 @@
;; KERNEL-level protocol ;; KERNEL-level protocol
(struct udp-datagram (source-ip source-port destination-ip destination-port body) #:prefab) (struct udp-datagram (source-ip source-port destination-ip destination-port body) #:prefab)
(struct udp-port-allocation (port handle) #:prefab) ;; (udp-port-allocation Number UdpLocalAddress)
(define any-remote (udp-remote-address ? ?)) (define any-remote (udp-remote-address ? ?))
@ -51,26 +52,24 @@
(define (spawn-udp-driver) (define (spawn-udp-driver)
(list (list
(spawn-demand-matcher (udp-packet ? (?! (udp-listener ?)) ?) (spawn-demand-matcher (observe (udp-packet ? (?! (udp-listener ?)) ?))
#:demand-is-subscription? #t (advertise (udp-packet ? (?! (udp-listener ?)) ?))
(lambda (handle) (spawn-udp-relay (udp-listener-port handle) handle))) (lambda (handle) (spawn-udp-relay (udp-listener-port handle) handle)))
(spawn-demand-matcher (udp-packet ? (?! (udp-handle ?)) ?) (spawn-demand-matcher (observe (udp-packet ? (?! (udp-handle ?)) ?))
#:demand-is-subscription? #t (advertise (udp-packet ? (?! (udp-handle ?)) ?))
(lambda (handle) (lambda (handle)
(send (port-allocation-request (message (port-allocation-request
'udp 'udp
(lambda (port local-ips) (spawn-udp-relay port handle)))))) (lambda (port local-ips) (spawn-udp-relay port handle))))))
(spawn-udp-port-allocator) (spawn-udp-port-allocator)
(spawn-kernel-udp-driver))) (spawn-kernel-udp-driver)))
(define (spawn-udp-port-allocator) (define (spawn-udp-port-allocator)
(define udp-projector (project-pubs (udp-datagram (?!) (?!) ? ? ?))) (define udp-projector (udp-port-allocation (?!) ?))
(spawn-port-allocator 'udp (spawn-port-allocator 'udp
(list (projection->gestalt udp-projector)) (subscription (projection->pattern udp-projector))
(lambda (g local-ips) (lambda (g local-ips)
(for/set [(e (gestalt-project/keys g udp-projector)) (project-assertions g udp-projector))))
#:when (set-member? local-ips (car e))]
(cadr e)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Relaying ;; Relaying
@ -78,44 +77,45 @@
(define (spawn-udp-relay local-port local-user-addr) (define (spawn-udp-relay local-port local-user-addr)
(log-info "Spawning UDP relay ~v / ~v" local-port local-user-addr) (log-info "Spawning UDP relay ~v / ~v" local-port local-user-addr)
(define local-peer-gestalt (pub (udp-packet any-remote local-user-addr ?) #:level 1)) (define local-peer-detector (?! (observe (udp-packet any-remote local-user-addr ?))))
(define (compute-gestalt local-ips) (define (compute-gestalt local-ips)
(for/fold [(g (gestalt-union local-peer-gestalt (for/fold [(g (assertion-set-union
observe-local-ip-addresses-gestalt (subscription (projection->pattern local-peer-detector))
(pub (udp-packet any-remote local-user-addr ?)) (advertisement (udp-packet any-remote local-user-addr ?))
(sub (udp-packet local-user-addr any-remote ?))))] observe-local-ip-addresses-gestalt
[(ip (in-set local-ips))] (subscription (udp-packet local-user-addr any-remote ?))
(gestalt-union g (assertion (udp-port-allocation local-port local-user-addr))))]
(sub (udp-datagram ? ? ip local-port ?)) [(ip (in-set local-ips))]
(pub (udp-datagram ip local-port ? ? ?))))) (assertion-set-union g
(subscription (udp-datagram ? ? ip local-port ?))
(advertisement (udp-datagram ip local-port ? ? ?)))))
(spawn (lambda (e local-ips) (spawn (lambda (e local-ips)
(match e (match e
[(routing-update g) [(scn g)
(define new-local-ips (gestalt->local-ip-addresses g)) (define new-local-ips (gestalt->local-ip-addresses g))
(transition new-local-ips (if (trie-empty? (trie-project g (compile-projection local-peer-detector)))
(list (quit)
(when (gestalt-empty? (gestalt-filter g local-peer-gestalt)) (quit)) (transition new-local-ips (scn (compute-gestalt new-local-ips))))]
(routing-update (compute-gestalt new-local-ips))))] [(message (udp-packet (== local-user-addr) remote-addr bs))
[(message (udp-packet (== local-user-addr) remote-addr bs) _ _)
;; Choose arbitrary local IP address for outbound packet! ;; Choose arbitrary local IP address for outbound packet!
;; TODO: what can be done? Must I examine the routing table? ;; TODO: what can be done? Must I examine the routing table?
(match-define (udp-remote-address remote-host remote-port) remote-addr) (match-define (udp-remote-address remote-host remote-port) remote-addr)
(define remote-ip (ip-string->ip-address remote-host)) (define remote-ip (ip-string->ip-address remote-host))
(transition local-ips (send (udp-datagram (set-first local-ips) (transition local-ips (message (udp-datagram (set-first local-ips)
local-port local-port
remote-ip remote-ip
remote-port remote-port
bs)))] bs)))]
[(message (udp-datagram si sp _ _ bs) _ _) [(message (udp-datagram si sp _ _ bs))
(transition local-ips (send (udp-packet (udp-remote-address (ip-address->hostname si) (transition local-ips
sp) (message (udp-packet (udp-remote-address (ip-address->hostname si) sp)
local-user-addr local-user-addr
bs)))] bs)))]
[_ #f])) [_ #f]))
(set) (set)
(compute-gestalt (set)))) (scn (compute-gestalt (set)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Codec & kernel-level driver ;; Codec & kernel-level driver
@ -125,9 +125,9 @@
(define (spawn-kernel-udp-driver) (define (spawn-kernel-udp-driver)
(spawn (lambda (e local-ips) (spawn (lambda (e local-ips)
(match e (match e
[(routing-update g) [(scn g)
(transition (gestalt->local-ip-addresses g) '())] (transition (gestalt->local-ip-addresses g) '())]
[(message (ip-packet source-if src-ip dst-ip _ _ body) _ _) [(message (ip-packet source-if src-ip dst-ip _ _ body))
#:when (and source-if (set-member? local-ips dst-ip)) #:when (and source-if (set-member? local-ips dst-ip))
(bit-string-case body (bit-string-case body
([ (src-port :: integer bytes 2) ([ (src-port :: integer bytes 2)
@ -138,14 +138,14 @@
(bit-string-case data (bit-string-case data
([ (payload :: binary bytes (- length 8)) ;; min UDP header size is 8 bytes ([ (payload :: binary bytes (- length 8)) ;; min UDP header size is 8 bytes
(:: binary) ] (:: binary) ]
(transition local-ips (send (udp-datagram src-ip (transition local-ips (message (udp-datagram src-ip
src-port src-port
dst-ip dst-ip
dst-port dst-port
(bit-string->bytes payload))))) (bit-string->bytes payload)))))
(else #f))) (else #f)))
(else #f))] (else #f))]
[(message (udp-datagram src-ip src-port dst-ip dst-port bs) _ _) [(message (udp-datagram src-ip src-port dst-ip dst-port bs))
#:when (set-member? local-ips src-ip) #:when (set-member? local-ips src-ip)
(let* ((payload (bit-string (src-port :: integer bytes 2) (let* ((payload (bit-string (src-port :: integer bytes 2)
(dst-port :: integer bytes 2) (dst-port :: integer bytes 2)
@ -161,15 +161,15 @@
:: integer bytes 2))) :: integer bytes 2)))
(checksummed-payload (ip-checksum #:pseudo-header pseudo-header (checksummed-payload (ip-checksum #:pseudo-header pseudo-header
6 payload))) 6 payload)))
(transition local-ips (send (ip-packet #f (transition local-ips (message (ip-packet #f
src-ip src-ip
dst-ip dst-ip
PROTOCOL-UDP PROTOCOL-UDP
#"" #""
checksummed-payload))))] checksummed-payload))))]
[_ #f])) [_ #f]))
(set) (set)
(gestalt-union (pub (ip-packet #f ? ? PROTOCOL-UDP ? ?)) (scn/union (advertisement (ip-packet #f ? ? PROTOCOL-UDP ? ?))
(sub (ip-packet ? ? ? PROTOCOL-UDP ? ?)) (subscription (ip-packet ? ? ? PROTOCOL-UDP ? ?))
(sub (udp-datagram ? ? ? ? ?)) (subscription (udp-datagram ? ? ? ? ?))
observe-local-ip-addresses-gestalt))) observe-local-ip-addresses-gestalt)))