diff --git a/conversation.rkt b/conversation.rkt index 3e18ef1..9fa7dc8 100644 --- a/conversation.rkt +++ b/conversation.rkt @@ -9,8 +9,11 @@ (require "standard-thread.rkt") (provide make-room + room? room-name join-room + wait-for-members + spy-on ;; Management and communication (struct-out arrived) @@ -51,6 +54,28 @@ #:invisible? [invisible? #f]) (make-object membership% (room-ch room) name break-on-departure? invisible?)) +(define (wait-for-members room members) + (define handle (join-room room (gensym 'wait-for-members) #:invisible? #t)) + (let loop ((remaining-members members)) + (if (null? remaining-members) + #t + (match (send handle listen) + ((arrived who) (loop (remove who remaining-members))) + ((departed who _) (if (member who members) + (error 'wait-for-members "Waited-for member exited") + (loop remaining-members))) + (_ (loop remaining-members))))) + (send handle depart)) + +(define (spy-on room) + (thread (lambda () + (define spy-name (gensym 'spy)) + (define handle (join-room room spy-name #:invisible? #t)) + (let loop () + (define message (send handle listen)) + (log-info (format "~s/~s: ~s" spy-name (room-name room) message)) + (loop))))) + (define membership% (class* object% () (init room-init) diff --git a/ssh-session.rkt b/ssh-session.rkt index 035798a..3638dfa 100644 --- a/ssh-session.rkt +++ b/ssh-session.rkt @@ -639,28 +639,6 @@ SSH_MSG_DEBUG handle-msg-debug SSH_MSG_KEXINIT handle-msg-kexinit)) -(define (spy-on room) - (define handle (join-room room (gensym 'spy) #:invisible? #t)) - (define (loop) - (write (list (room-name room) (send handle listen))) - (newline) - (flush-output) - (loop)) - (thread loop)) - -(define (wait-for-members room members) - (define handle (join-room room (gensym 'wait-for-members) #:invisible? #t)) - (let loop ((remaining-members members)) - (if (null? remaining-members) - #t - (match (send handle listen) - ((arrived who) (loop (remove who remaining-members))) - ((departed who _) (if (member who members) - (error 'wait-for-members "Waited-for member exited") - (loop remaining-members))) - (_ (loop remaining-members))))) - (send handle depart)) - (define (ssh-session role in out) (define io-room (make-room (gensym 'ssh-session-io-room))) (spy-on io-room)