We have to be more careful about observing at level 3 while projecting at level 1

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

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

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