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

Better protocol separation between user and kernel layers of UDP

This commit is contained in:
Tony Garnock-Jones 2014-06-19 22:18:04 -04:00
parent ae9887b8fb
commit 191a71ec80
1 changed files with 56 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
udp.rkt
View File

@ -38,8 +38,12 @@
(or (udp-handle? x) (or (udp-handle? x)
(udp-listener? x))) (udp-listener? x)))
;; USER-level protocol
(struct udp-packet (source destination body) #:prefab) (struct udp-packet (source destination body) #:prefab)
;; KERNEL-level protocol
(struct udp-datagram (source-ip source-port destination-ip destination-port body) #:prefab)
(define any-remote (udp-remote-address ? ?)) (define any-remote (udp-remote-address ? ?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -56,11 +60,18 @@
(send (port-allocation-request (send (port-allocation-request
'udp 'udp
(lambda (port local-ips) (spawn-udp-relay port handle)))))) (lambda (port local-ips) (spawn-udp-relay port handle))))))
(spawn-port-allocator 'udp (spawn-udp-port-allocator)
(list (project-subs (udp-packet (udp-remote-address (?!) (?!)) ? ?))
(project-subs (udp-packet ? (udp-remote-address (?!) (?!)) ?))))
(spawn-kernel-udp-driver))) (spawn-kernel-udp-driver)))
(define (spawn-udp-port-allocator)
(define udp-projector (project-pubs (udp-datagram (?!) (?!) ? ? ?)))
(spawn-port-allocator 'udp
(list udp-projector)
(lambda (g local-ips)
(for/set [(e (gestalt-project/keys g udp-projector))
#:when (set-member? local-ips (car e))]
(cadr e)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Relaying ;; Relaying
@ -75,18 +86,14 @@
(pub (udp-packet any-remote local-user-addr ?)) (pub (udp-packet any-remote local-user-addr ?))
(sub (udp-packet local-user-addr any-remote ?))))] (sub (udp-packet local-user-addr any-remote ?))))]
[(ip (in-set local-ips))] [(ip (in-set local-ips))]
(define hostname (ip-address->hostname ip))
(define local-network-addr (udp-remote-address hostname local-port))
(gestalt-union g (gestalt-union g
(sub (udp-packet any-remote local-network-addr ?)) (sub (udp-datagram ? ? ip local-port ?))
(pub (udp-packet local-network-addr any-remote ?))))) (pub (udp-datagram ip local-port ? ? ?)))))
(spawn (lambda (e local-ips) (spawn (lambda (e local-ips)
(log-info "RELAY ~v" e)
(match e (match e
[(routing-update g) [(routing-update g)
(define new-local-ips (gestalt->local-ip-addresses g)) (define new-local-ips (gestalt->local-ip-addresses g))
(log-info "Updating relay gestalt:\n~a" (gestalt->pretty-string (compute-gestalt new-local-ips)))
(transition new-local-ips (transition new-local-ips
(list (list
(when (gestalt-empty? (gestalt-filter g local-peer-gestalt)) (quit)) (when (gestalt-empty? (gestalt-filter g local-peer-gestalt)) (quit))
@ -94,11 +101,18 @@
[(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?
(define local-network-addr (match-define (udp-remote-address remote-host remote-port) remote-addr)
(udp-remote-address (ip-address->hostname (set-first local-ips)) local-port)) (define remote-ip (ip-string->ip-address remote-host))
(transition local-ips (send (udp-packet local-network-addr remote-addr bs)))] (transition local-ips (send (udp-datagram (set-first local-ips)
[(message (udp-packet remote-addr (udp-remote-address _ _) bs) _ _) local-port
(transition local-ips (send (udp-packet remote-addr local-user-addr bs)))] remote-ip
remote-port
bs)))]
[(message (udp-datagram si sp _ _ bs) _ _)
(transition local-ips (send (udp-packet (udp-remote-address (ip-address->hostname si)
sp)
local-user-addr
bs)))]
[_ #f])) [_ #f]))
(set) (set)
(compute-gestalt (set)))) (compute-gestalt (set))))
@ -115,8 +129,6 @@
(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))
(define src-host (ip-address->hostname src-ip))
(define dst-host (ip-address->hostname dst-ip))
(bit-string-case body (bit-string-case body
([ (src-port :: integer bytes 2) ([ (src-port :: integer bytes 2)
(dst-port :: integer bytes 2) (dst-port :: integer bytes 2)
@ -126,39 +138,38 @@
(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-packet (udp-remote-address src-host src-port) (transition local-ips (send (udp-datagram src-ip
(udp-remote-address dst-host dst-port) src-port
(bit-string->bytes payload))))) dst-ip
dst-port
(bit-string->bytes payload)))))
(else #f))) (else #f)))
(else #f))] (else #f))]
[(message (udp-packet (udp-remote-address sh sp) (udp-remote-address dh dp) bs) _ _) [(message (udp-datagram src-ip src-port dst-ip dst-port bs) _ _)
(define src-ip (ip-string->ip-address sh)) #:when (set-member? local-ips src-ip)
(define dst-ip (ip-string->ip-address dh)) (let* ((payload (bit-string (src-port :: integer bytes 2)
(and (set-member? local-ips src-ip) (dst-port :: integer bytes 2)
(let* ((payload (bit-string (sp :: integer bytes 2) ((+ 8 (bit-string-byte-count bs))
(dp :: integer bytes 2) :: integer bytes 2)
((+ 8 (bit-string-byte-count bs)) (0 :: integer bytes 2) ;; checksum location
:: integer bytes 2) (bs :: binary)))
(0 :: integer bytes 2) ;; checksum location (pseudo-header (bit-string (src-ip :: binary bytes 4)
(bs :: binary))) (dst-ip :: binary bytes 4)
(pseudo-header (bit-string (src-ip :: binary bytes 4) 0
(dst-ip :: binary bytes 4) PROTOCOL-UDP
0 ((bit-string-byte-count payload)
PROTOCOL-UDP :: integer bytes 2)))
((bit-string-byte-count payload) (checksummed-payload (ip-checksum #:pseudo-header pseudo-header
:: integer bytes 2))) 6 payload)))
(checksummed-payload (ip-checksum #:pseudo-header pseudo-header (transition local-ips (send (ip-packet #f
6 payload))) src-ip
(transition local-ips (send (ip-packet #f dst-ip
src-ip PROTOCOL-UDP
dst-ip #""
PROTOCOL-UDP checksummed-payload))))]
#""
checksummed-payload)))))]
[_ #f])) [_ #f]))
(set) (set)
(gestalt-union (pub (ip-packet #f ? ? PROTOCOL-UDP ? ?)) (gestalt-union (pub (ip-packet #f ? ? PROTOCOL-UDP ? ?))
(sub (ip-packet ? ? ? PROTOCOL-UDP ? ?)) (sub (ip-packet ? ? ? PROTOCOL-UDP ? ?))
(sub (udp-packet any-remote any-remote ?)) (sub (udp-datagram ? ? ? ? ?))
(pub (udp-packet any-remote any-remote ?))
observe-local-ip-addresses-gestalt))) observe-local-ip-addresses-gestalt)))