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

Name process behaviour procedures.

This commit is contained in:
Tony Garnock-Jones 2016-01-27 21:46:09 -05:00
parent 0db231575c
commit a86eb10494
3 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
ip.rkt
View File

@ -301,7 +301,8 @@
full-packet)
(define (lookup-arp ipaddr query-interface-pattern base-gestalt k)
(on-claim (lambda (_g arp-results)
(on-claim #:name (string->symbol (format "lookup-arp:~a" (ip-address->hostname ipaddr)))
(lambda (_g arp-results)
(if (not arp-results)
(error 'ip "Someone has published a wildcard arp result")
(and (not (set-empty? arp-results))

3
port-allocator.rkt
View File

@ -14,7 +14,8 @@
(struct port-allocator-state (used-ports local-ips) #:transparent)
(define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports)
(spawn (lambda (e s)
(spawn #:name (string->symbol (format "port-allocator:~a" allocator-type))
(lambda (e s)
(match e
[(scn g)
(define local-ips (or (gestalt->local-ip-addresses g) (set)))

28
tcp.rkt
View File

@ -51,16 +51,20 @@
;; User-accessible driver startup
(define (spawn-tcp-driver)
(list (spawn-demand-matcher (advertise (observe (tcp-channel ? (?! (tcp-listener ?)) ?)))
(list (spawn-demand-matcher #:name 'tcp-inbound-driver
(advertise (observe (tcp-channel ? (?! (tcp-listener ?)) ?)))
(advertise (advertise (tcp-channel ? (?! (tcp-listener ?)) ?)))
(lambda (server-addr)
(match-define (tcp-listener port) server-addr)
;; TODO: have listener shut down once user-level listener does
(list
(spawn (lambda (e s) #f)
(spawn #:name (string->symbol
(format "tcp-listener-port-reservation:~a" port))
(lambda (e s) #f)
(void)
(scn (assertion (tcp-port-allocation port server-addr))))
(spawn-demand-matcher
#:name (string->symbol (format "tcp-listener:~a" port))
(advertise (tcp-channel (?! (tcp-address ? ?))
(?! (tcp-address ? port))
?))
@ -68,7 +72,8 @@
(?! (tcp-address ? port))
?))
(spawn-relay server-addr)))))
(spawn-demand-matcher (advertise (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
(spawn-demand-matcher #:name 'tcp-outbound-driver
(advertise (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
(observe (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
allocate-port-and-spawn-socket)
(spawn-tcp-port-allocator)
@ -116,7 +121,11 @@
(define remote-peer-traffic (?! (advertise (tcp-channel remote-addr local-tcp-addr ?))))
(list
(message (set-timer timer-name relay-peer-wait-time-msec 'relative))
(spawn (lambda (e state)
(spawn #:name (string->symbol (format "tcp-relay:~v:~v:~v"
local-user-addr
remote-addr
local-tcp-addr))
(lambda (e state)
(match e
[(scn g)
(define local-peer-absent?
@ -287,7 +296,8 @@
(transition s (message (ip-packet #f src-ip dst-ip PROTOCOL-TCP #""
(ip-checksum 16 payload #:pseudo-header pseudo-header)))))
(spawn (lambda (e s)
(spawn #:name 'kernel-tcp-driver
(lambda (e s)
(match e
[(scn g)
(analyze-gestalt g s)]
@ -612,6 +622,12 @@
(current-inexact-milliseconds)
#f
#f)))
(spawn state-vector-behavior
(spawn #:name
(string->symbol (format "tcp-state-vector:~a:~a:~a:~a"
(ip-address->hostname src-ip)
src-port
(ip-address->hostname dst-ip)
dst-port))
state-vector-behavior
state0
(scn (compute-gestalt state0))))))