From a86eb10494a1ae9398c81cba99fdf5e82a4868b7 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Wed, 27 Jan 2016 21:46:09 -0500
Subject: [PATCH] Name process behaviour procedures.

---
 ip.rkt             |  3 ++-
 port-allocator.rkt |  3 ++-
 tcp.rkt            | 28 ++++++++++++++++++++++------
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/ip.rkt b/ip.rkt
index 7166647..44b3d01 100644
--- a/ip.rkt
+++ b/ip.rkt
@@ -301,7 +301,8 @@
   full-packet)
 
 (define (lookup-arp ipaddr query-interface-pattern base-gestalt k)
-  (on-claim (lambda (_g arp-results)
+  (on-claim #:name (string->symbol (format "lookup-arp:~a" (ip-address->hostname ipaddr)))
+            (lambda (_g arp-results)
               (if (not arp-results)
                   (error 'ip "Someone has published a wildcard arp result")
                   (and (not (set-empty? arp-results))
diff --git a/port-allocator.rkt b/port-allocator.rkt
index 533a9e4..e0fe75c 100644
--- a/port-allocator.rkt
+++ b/port-allocator.rkt
@@ -14,7 +14,8 @@
 (struct port-allocator-state (used-ports local-ips) #:transparent)
 
 (define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports)
-  (spawn (lambda (e s)
+  (spawn #:name (string->symbol (format "port-allocator:~a" allocator-type))
+         (lambda (e s)
 	   (match e
 	     [(scn g)
 	      (define local-ips (or (gestalt->local-ip-addresses g) (set)))
diff --git a/tcp.rkt b/tcp.rkt
index 3f2bca1..1aa461d 100644
--- a/tcp.rkt
+++ b/tcp.rkt
@@ -51,16 +51,20 @@
 ;; User-accessible driver startup
 
 (define (spawn-tcp-driver)
-  (list (spawn-demand-matcher (advertise (observe (tcp-channel ? (?! (tcp-listener ?)) ?)))
+  (list (spawn-demand-matcher #:name 'tcp-inbound-driver
+                              (advertise (observe (tcp-channel ? (?! (tcp-listener ?)) ?)))
                               (advertise (advertise (tcp-channel ? (?! (tcp-listener ?)) ?)))
 			      (lambda (server-addr)
 				(match-define (tcp-listener port) server-addr)
 				;; TODO: have listener shut down once user-level listener does
                                 (list
-                                 (spawn (lambda (e s) #f)
+                                 (spawn #:name (string->symbol
+                                                (format "tcp-listener-port-reservation:~a" port))
+                                        (lambda (e s) #f)
                                         (void)
                                         (scn (assertion (tcp-port-allocation port server-addr))))
                                  (spawn-demand-matcher
+                                  #:name (string->symbol (format "tcp-listener:~a" port))
                                   (advertise (tcp-channel (?! (tcp-address ? ?))
                                                           (?! (tcp-address ? port))
                                                           ?))
@@ -68,7 +72,8 @@
                                                         (?! (tcp-address ? port))
                                                         ?))
                                   (spawn-relay server-addr)))))
-	(spawn-demand-matcher (advertise (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
+	(spawn-demand-matcher #:name 'tcp-outbound-driver
+                              (advertise (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
                               (observe (tcp-channel (?! (tcp-handle ?)) (?! (tcp-address ? ?)) ?))
                               allocate-port-and-spawn-socket)
 	(spawn-tcp-port-allocator)
@@ -116,7 +121,11 @@
   (define remote-peer-traffic (?! (advertise (tcp-channel remote-addr local-tcp-addr ?))))
   (list
    (message (set-timer timer-name relay-peer-wait-time-msec 'relative))
-   (spawn (lambda (e state)
+   (spawn #:name (string->symbol (format "tcp-relay:~v:~v:~v"
+                                         local-user-addr
+                                         remote-addr
+                                         local-tcp-addr))
+          (lambda (e state)
 	    (match e
 	      [(scn g)
 	       (define local-peer-absent?
@@ -287,7 +296,8 @@
     (transition s (message (ip-packet #f src-ip dst-ip PROTOCOL-TCP #""
                                       (ip-checksum 16 payload #:pseudo-header pseudo-header)))))
 
-  (spawn (lambda (e s)
+  (spawn #:name 'kernel-tcp-driver
+         (lambda (e s)
 	   (match e
 	     [(scn g)
 	      (analyze-gestalt g s)]
@@ -612,6 +622,12 @@
 			     (current-inexact-milliseconds)
 			     #f
 			     #f)))
-     (spawn state-vector-behavior
+     (spawn #:name
+            (string->symbol (format "tcp-state-vector:~a:~a:~a:~a"
+                                    (ip-address->hostname src-ip)
+                                    src-port
+                                    (ip-address->hostname dst-ip)
+                                    dst-port))
+            state-vector-behavior
 	    state0
 	    (scn (compute-gestalt state0))))))