Support invisible room members.

conversation.rkt

@@ -32,6 +32,7 @@
 (struct room-state (name ch members) #:transparent)
 (struct binding (name ;; any
 		 break-on-departure? ;; boolean
+		 invisible? ;; boolean
 		 in-ch ;; sync channel
 		 out-ch ;; sync channel
 		 disconnect-box ;; blocking-box
@@ -45,14 +46,17 @@
   (thread (lambda () (room-main (room-state name ch '()))))
   (room name ch))
 
-(define (join-room room [name (gensym 'peer)] #:break-on-departure? [break-on-departure? #f])
+(define (join-room room [name (gensym 'peer)]
-  (make-object membership% (room-ch room) name break-on-departure?))
+		   #:break-on-departure? [break-on-departure? #f]
+		   #:invisible? [invisible? #f])
+  (make-object membership% (room-ch room) name break-on-departure? invisible?))
 
 (define membership%
   (class* object% ()
     (init room-init)
     (init name-init)
     (init break-on-departure?-init)
+    (init invisible?-init)
 
     (super-new)
 
@@ -69,7 +73,7 @@
 					     (set! connected #f)
 					     (set! reason v)
 					     v)))
-    (channel-put room `(join ,name ,break-on-departure?-init
+    (channel-put room `(join ,name ,break-on-departure?-init ,invisible?-init
 			     ,out-ch ,in-ch ,disconnect-box
 			     ,(current-thread) ,(current-thread-exit-status)))
 
@@ -131,10 +135,10 @@
 					   (room-main (part state b (binding-death-reason b)))))))
 	       (handle-evt (room-state-ch state)
 			   (match-lambda
-			    (`(join ,name ,break-on-departure?
+			    (`(join ,name ,break-on-departure? ,invisible?
 				    ,in-ch ,out-ch ,disconnect-box
 				    ,thread ,exit-status)
-			     (room-main (join state name break-on-departure?
+			     (room-main (join state name break-on-departure? invisible?
 					      in-ch out-ch disconnect-box
 					      thread exit-status)))
 			    (unexpected (log-warning (format "room-main: unexpected message ~v"
@@ -155,18 +159,22 @@
 			       message))
 	  state)))
 
-(define (join state name break-on-departure?
+(define (join state name break-on-departure? invisible?
 	      in-ch out-ch disconnect-box
 	      thread exit-status)
-  (define b (binding name break-on-departure?
+  (define b (binding name break-on-departure? invisible?
 		     in-ch out-ch disconnect-box
 		     (box (list->queue (membership-summary state)))
 		     thread exit-status))
-  (broadcast (add-binding state b) b (arrived name)))
+  (if invisible?
+      (add-binding state b)
+      (broadcast (add-binding state b) b (arrived name))))
 
 (define (part state b why)
   (set-blocking-box! (binding-disconnect-box b) why)
-  (broadcast (remove-binding state b) b (departed (binding-name b) why)))
+  (if (binding-invisible? b)
+      (remove-binding state b)
+      (broadcast (remove-binding state b) b (departed (binding-name b) why))))
 
 (define (membership-summary state)
   (map (lambda (member) (arrived (binding-name member)))

ssh-session.rkt

@@ -528,7 +528,7 @@
 	  SSH_MSG_KEXINIT handle-msg-kexinit))
 
 (define (spy-on room)
-  (define handle (join-room room (gensym 'spy)))
+  (define handle (join-room room (gensym 'spy) #:invisible? #t))
   (define (loop)
     (write (list (room-name room) (send handle listen)))
     (newline)