From 33a60e4a0245707bc86b72fe56530b89b50a05ce Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 19 Jun 2014 22:27:19 -0400 Subject: [PATCH] We have to be more careful about observing at level 3 while projecting at level 1 --- port-allocator.rkt | 4 ++-- tcp.rkt | 11 ++++++++--- udp.rkt | 2 +- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/port-allocator.rkt b/port-allocator.rkt index f175961..6466db3 100644 --- a/port-allocator.rkt +++ b/port-allocator.rkt @@ -13,7 +13,7 @@ (struct port-allocator-state (used-ports local-ips) #:transparent) -(define (spawn-port-allocator allocator-type projections compute-used-ports) +(define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports) (spawn (lambda (e s) (match e [(routing-update g) @@ -35,4 +35,4 @@ (apply gestalt-union (sub (port-allocation-request allocator-type ?)) observe-local-ip-addresses-gestalt - (map projection->gestalt projections)))) + observer-gestalt))) diff --git a/tcp.rkt b/tcp.rkt index 6f1965f..86e3359 100644 --- a/tcp.rkt +++ b/tcp.rkt @@ -68,11 +68,16 @@ (define (spawn-tcp-port-allocator) (define project-active-connections (project-pubs (tcp-packet #f (?!) (?!) ? ? ? ? ? ? ? ?))) - (define project-listeners (project-subs #:level 1 (tcp-channel ? (tcp-listener (?!)) ?))) + ;; We have to have gestalt observing listeners at level 3 so that + ;; we're not mistaken for listener supply! We still project out at + ;; level 1 (instead of level 2, as would be natural for a level 3 + ;; observer gestalt) though. + (define listeners-p (project-subs #:level 1 (tcp-channel ? (tcp-listener (?!)) ?))) + (define listeners-g (pub #:level 3 (tcp-channel ? (tcp-listener ?) ?))) (spawn-port-allocator 'tcp - (list project-active-connections project-listeners) + (list (projection->gestalt project-active-connections) listeners-g) (lambda (g local-ips) - (define listener-ports (gestalt-project/single g project-listeners)) + (define listener-ports (gestalt-project/single g listeners-p)) (define active-connection-ports (for/set [(e (gestalt-project/keys g project-active-connections)) #:when (set-member? local-ips (car e))] diff --git a/udp.rkt b/udp.rkt index 4841c68..a2444c5 100644 --- a/udp.rkt +++ b/udp.rkt @@ -66,7 +66,7 @@ (define (spawn-udp-port-allocator) (define udp-projector (project-pubs (udp-datagram (?!) (?!) ? ? ?))) (spawn-port-allocator 'udp - (list udp-projector) + (list (projection->gestalt udp-projector)) (lambda (g local-ips) (for/set [(e (gestalt-project/keys g udp-projector)) #:when (set-member? local-ips (car e))]