Driver now only creates resources for fully grounded local addresses.
This commit is contained in:
parent
f1f7cc0d8c
commit
f597cfe33d
35
os2-tcp.rkt
35
os2-tcp.rkt
|
@ -6,6 +6,7 @@
|
|||
(require (prefix-in tcp: racket/tcp))
|
||||
(require racket/port)
|
||||
(require "os2.rkt")
|
||||
(require "unify.rkt")
|
||||
(require "dump-bytes.rkt")
|
||||
|
||||
(provide (struct-out tcp-address)
|
||||
|
@ -100,10 +101,11 @@
|
|||
;; Topic Set<HandleMapping> (TcpAddress TcpAddress -> BootK) -> Transition
|
||||
(define (maybe-spawn-socket t active-handles driver-fun)
|
||||
(match t
|
||||
[(or (topic 'publisher (tcp-channel local-addr remote-addr _) counterparty-virtual?)
|
||||
(topic 'subscriber (tcp-channel remote-addr local-addr _) counterparty-virtual?))
|
||||
[(or (topic 'publisher (tcp-channel local-addr remote-addr _) _)
|
||||
(topic 'subscriber (tcp-channel remote-addr local-addr _) _))
|
||||
(cond
|
||||
[counterparty-virtual? active-handles]
|
||||
[(ground? remote-addr) active-handles]
|
||||
[(not (ground? local-addr)) active-handles]
|
||||
[(set-member? active-handles (cons local-addr remote-addr)) active-handles]
|
||||
[else
|
||||
(transition (set-add active-handles (cons local-addr remote-addr))
|
||||
|
@ -113,10 +115,11 @@
|
|||
;; Topic Set<HandleMapping> -> Transition
|
||||
(define (maybe-forget-socket t active-handles)
|
||||
(match t
|
||||
[(or (topic 'publisher (tcp-channel local-addr _ _) counterparty-virtual?)
|
||||
(topic 'subscriber (tcp-channel _ local-addr _) counterparty-virtual?))
|
||||
[(or (topic 'publisher (tcp-channel local-addr remote-addr _) _)
|
||||
(topic 'subscriber (tcp-channel remote-addr local-addr _) _))
|
||||
(cond
|
||||
[counterparty-virtual? active-handles]
|
||||
[(ground? remote-addr) active-handles]
|
||||
[(not (ground? local-addr)) active-handles]
|
||||
[else (set-remove active-handles local-addr)])]))
|
||||
|
||||
;; TcpAddress TcpAddress -> BootK
|
||||
|
@ -128,13 +131,19 @@
|
|||
(set (topic-subscriber (tcp-channel local-addr any-remote (wild)) #:virtual? #t)
|
||||
(topic-publisher (tcp-channel any-remote local-addr (wild)) #:virtual? #t))
|
||||
#:state state
|
||||
#:on-absence (transition 'listener-is-closed
|
||||
(kill)
|
||||
(when (eq? state 'listener-is-running)
|
||||
(spawn (lambda (dummy-pid)
|
||||
(tcp:tcp-close listener)
|
||||
(transition 'dummy (kill)))
|
||||
#:debug-name (list 'tcp-listener-closer local-addr)))))
|
||||
#:topic t
|
||||
#:on-absence (match t
|
||||
[(or (topic 'publisher (tcp-channel (== local-addr) remote-addr _) _)
|
||||
(topic 'subscriber (tcp-channel remote-addr (== local-addr) _) _))
|
||||
(if (ground? remote-addr)
|
||||
state
|
||||
(transition 'listener-is-closed
|
||||
(kill)
|
||||
(when (eq? state 'listener-is-running)
|
||||
(spawn (lambda (dummy-pid)
|
||||
(tcp:tcp-close listener)
|
||||
(transition 'dummy (kill)))
|
||||
#:debug-name (list 'tcp-listener-closer local-addr)))))]))
|
||||
(role 'accepter (topic-subscriber (cons (tcp:tcp-accept-evt listener) (wild)))
|
||||
#:state state
|
||||
[(cons _ (list cin cout))
|
||||
|
|
Loading…
Reference in New Issue