Use monitors; tidy up debug output a little

This commit is contained in:
Tony Garnock-Jones 2012-06-19 11:38:33 -04:00
parent f69527bb14
commit f0a98bb1f9
2 changed files with 22 additions and 19 deletions

View File

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

View File

@ -543,8 +543,8 @@
peer-identification-string peer-identification-string
#f) #f)
(spawn (nested-vm 'ssh-application-vm application-boot) (spawn/monitor (nested-vm 'ssh-application-vm application-boot)
#:debug-name 'ssh-application-vm) #:debug-name 'ssh-application-vm)
(role 'rekey-waiter (topic-subscriber (timer-expired 'rekey-timer (wild))) (role 'rekey-waiter (topic-subscriber (timer-expired 'rekey-timer (wild)))
#:state conn #:state conn