From f0a98bb1f9371f7870f0eab129ecdfe7678a4dd1 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Tue, 19 Jun 2012 11:38:33 -0400
Subject: [PATCH] Use monitors; tidy up debug output a little

---
 new-server.rkt  | 37 ++++++++++++++++++++-----------------
 ssh-session.rkt |  4 ++--
 2 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/new-server.rkt b/new-server.rkt
index 799424e..7a82f6a 100644
--- a/new-server.rkt
+++ b/new-server.rkt
@@ -48,7 +48,7 @@
        (at-meta-level (send-tcp-mode remote-addr local-addr 'lines))
        (at-meta-level (send-tcp-credit remote-addr local-addr 1))
 
-       (spawn
+       (spawn/monitor
 	(transition 'handshake-is-stateless
 	  (at-meta-level
 	   (role 'socket-reader (topic-subscriber (tcp-channel remote-addr local-addr (wild)))
@@ -64,23 +64,30 @@
 	      (extend-transition
 		  (prefix-transition (ssh-reader local-addr remote-addr)
 		    (at-meta-level (send-tcp-mode remote-addr local-addr 'bytes)))
-		(spawn (ssh-writer local-addr remote-addr) #:debug-name 'ssh-writer)
+		(spawn/monitor (ssh-writer local-addr remote-addr) #:debug-name 'ssh-writer)
 		;; Wait for a cycle to let the reader and writer get
 		;; started, then tell the reader we are ready for a
 		;; single packet and spawn the session manager.
 		(yield #:state state
 		  (transition state
 		    (send-message (inbound-credit 1))
-		    (spawn (ssh-session local-identification
-					remote-identification
-					repl-boot
-					'server)
-			   #:debug-name 'ssh-session))))])))
+		    (spawn/monitor (ssh-session local-identification
+						remote-identification
+						repl-boot
+						'server)
+				   #:debug-name 'ssh-session))))])))
 	#:debug-name 'ssh-reader)
 
-       (role 'crash-listener
-	   (set (topic-subscriber (wild) #:virtual? #t)
-		(topic-publisher (wild) #:virtual? #t))
+       (role 'spy (or (topic-subscriber (wild) #:virtual? #t)
+		      (topic-publisher (wild) #:virtual? #t))
+	 #:state state
+	 [message
+	  (write `(SSH ,message))
+	  (newline)
+	  (flush-output)
+	  state])
+
+       (role 'monitor-listener (topic-subscriber (monitor (wild) (wild)))
 	 #:state state
 	 #:reason reason
 	 #:on-absence
@@ -88,6 +95,7 @@
 	 ;; invoked several times in a row because of multiple flows
 	 ;; intersecting this role, we have to be careful to make the
 	 ;; transmission of the disconnection packet idempotent.
+	 ;; TODO: this is likely no longer true now we're using monitors %%%
 	 (if (eq? state 'running)
 	     (if (and (exn:fail:contract:protocol? reason)
 		      (not (exn:fail:contract:protocol-originated-at-peer? reason)))
@@ -99,18 +107,13 @@
 		   (yield #:state state
 		     (transition state (at-meta-level (kill)))))
 		 (transition state (at-meta-level (kill #:reason reason))))
-	     state)
-	 [msg
-	  (write (list 'SSH msg))
-	  (newline)
-	  (flush-output)
-	  state])))))
+	     state))))))
 
 (ground-vm
  (transition 'no-state
    (spawn (timer-driver 'timer-driver))
    (spawn tcp-driver #:debug-name 'tcp-driver)
-   (spawn tcp-spy #:debug-name 'tcp-spy)
+   ;;(spawn tcp-spy #:debug-name 'tcp-spy)
 
    (spawn (transition 'no-state
 	    (role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild))
diff --git a/ssh-session.rkt b/ssh-session.rkt
index 831ac5d..796987c 100644
--- a/ssh-session.rkt
+++ b/ssh-session.rkt
@@ -543,8 +543,8 @@
 			    peer-identification-string
 			    #f)
 
-      (spawn (nested-vm 'ssh-application-vm application-boot)
-	     #:debug-name 'ssh-application-vm)
+      (spawn/monitor (nested-vm 'ssh-application-vm application-boot)
+		     #:debug-name 'ssh-application-vm)
 
       (role 'rekey-waiter (topic-subscriber (timer-expired 'rekey-timer (wild)))
 	#:state conn