Use monitors; tidy up debug output a little
This commit is contained in:
parent
f69527bb14
commit
f0a98bb1f9
|
@ -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,30 +64,38 @@
|
|||
(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
|
||||
(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)
|
||||
(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
|
||||
;; This is kind of gross: because the absence handler gets
|
||||
;; 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))
|
||||
|
|
|
@ -543,7 +543,7 @@
|
|||
peer-identification-string
|
||||
#f)
|
||||
|
||||
(spawn (nested-vm 'ssh-application-vm application-boot)
|
||||
(spawn/monitor (nested-vm 'ssh-application-vm application-boot)
|
||||
#:debug-name 'ssh-application-vm)
|
||||
|
||||
(role 'rekey-waiter (topic-subscriber (timer-expired 'rekey-timer (wild)))
|
||||
|
|
Loading…
Reference in New Issue