Driver now only creates resources for fully grounded local addresses.

This commit is contained in:
Tony Garnock-Jones 2012-05-11 14:58:16 -04:00
parent f1f7cc0d8c
commit f597cfe33d
1 changed files with 22 additions and 13 deletions

View File

@ -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))