diff --git a/port-allocator.rkt b/port-allocator.rkt
index fbfed66..f175961 100644
--- a/port-allocator.rkt
+++ b/port-allocator.rkt
@@ -13,20 +13,12 @@
 
 (struct port-allocator-state (used-ports local-ips) #:transparent)
 
-(define (spawn-port-allocator allocator-type port-projections)
+(define (spawn-port-allocator allocator-type projections compute-used-ports)
   (spawn (lambda (e s)
 	   (match e
 	     [(routing-update g)
 	      (define local-ips (or (gestalt->local-ip-addresses g) (set)))
-	      (define extracted-ips+ports
-		(apply set-union
-		       (set)
-		       (map (lambda (p) (or (gestalt-project/keys g p) (set))) port-projections)))
-	      (define new-used-ports (for/fold [(s (set))] [(e (in-set extracted-ips+ports))]
-				       (match-define (list hostname port) e)
-				       (if (set-member? local-ips (ip-string->ip-address hostname))
-					   (set-add s port)
-					   s)))
+	      (define new-used-ports (compute-used-ports g local-ips))
 	      (log-info "port-allocator ~v used ports: ~v" allocator-type new-used-ports)
 	      (transition (port-allocator-state new-used-ports local-ips) '())]
 	     [(message (port-allocation-request _ k) _ _)
@@ -43,4 +35,4 @@
 	 (apply gestalt-union
 		(sub (port-allocation-request allocator-type ?))
 		observe-local-ip-addresses-gestalt
-		(map projection->gestalt port-projections))))
+		(map projection->gestalt projections))))
diff --git a/tcp.rkt b/tcp.rkt
index 5955717..fb311e3 100644
--- a/tcp.rkt
+++ b/tcp.rkt
@@ -54,19 +54,31 @@
 			      #:supply-level 2
 			      (lambda (server-addr)
 				(match-define (tcp-listener port) server-addr)
+				;; TODO: have listener shut down once user-level listener does
 				(spawn-demand-matcher
 				 (tcp-channel (?! (tcp-address ? ?)) (?! (tcp-address ? port)) ?)
 				 (spawn-relay server-addr))))
 	(spawn-demand-matcher (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?)
 			      allocate-port-and-spawn-socket)
-	(spawn-port-allocator 'tcp
-			      (list (project-subs (tcp-channel (tcp-address (?!) (?!)) ? ?))
-				    (project-subs (tcp-channel ? (tcp-address (?!) (?!)) ?))))
+	(spawn-tcp-port-allocator)
 	(spawn-kernel-tcp-driver)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Port allocation
 
+(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 (?!)) ?)))
+  (spawn-port-allocator 'tcp
+			(list project-active-connections project-listeners)
+			(lambda (g local-ips)
+			  (define listener-ports (gestalt-project/single g project-listeners))
+			  (define active-connection-ports
+			    (for/set [(e (gestalt-project/keys g project-active-connections))
+				      #:when (set-member? local-ips (car e))]
+			      (cadr e)))
+			  (set-union listener-ports active-connection-ports))))
+
 (define (allocate-port-and-spawn-socket local-addr remote-addr)
   (send (port-allocation-request
 	 'tcp
@@ -273,7 +285,6 @@
 	 (gestalt-union (pub (ip-packet #f ? ? PROTOCOL-TCP ? ?))
 			(sub (ip-packet ? ? ? PROTOCOL-TCP ? ?))
 			(sub (tcp-packet #f ? ? ? ? ? ? ? ? ? ?))
-			(pub (tcp-packet #t ? ? ? ? ? ? ? ? ? ?))
 			(pub (tcp-packet #t ? ? ? ? ? ? ? ? ? ?) #:level 1)
 			observe-local-ip-addresses-gestalt)))