diff --git a/new-server.rkt b/new-server.rkt index c1e95aa..f07284d 100644 --- a/new-server.rkt +++ b/new-server.rkt @@ -52,7 +52,7 @@ "Invalid peer identification string ~v" peer-identification-string))) -(define (repl-boot self-pid) +(define ((repl-boot user-name) self-pid) (transition 'no-repl-state (spawn event-relay #:debug-name (debug-name 'repl-event-relay)) (role 'spy (or (topic-subscriber (wild) #:monitor? #t) @@ -70,7 +70,8 @@ #:topic t #:on-presence (match t [(topic _ (channel-message (channel-stream-name _ cname) _) _) - (transition state (spawn (repl-instance cname) #:debug-name cname))]))))) + (transition state (spawn (repl-instance user-name cname) + #:debug-name cname))]))))) ;; (repl-instance InputPort OutputPort InputPort OutputPort) @@ -80,7 +81,7 @@ s2c-out ;; used by thread to write output to relay ) #:prefab) -(define (repl-instance cname) +(define (repl-instance user-name cname) (define inbound-stream (channel-stream-name #t cname)) (define outbound-stream (channel-stream-name #f cname)) (define (ch-do action-ctor stream body) @@ -101,9 +102,7 @@ (match-define (repl-instance-state c2s-in _ s2c-in s2c-out) state) (define buffer-size 1024) (define dummy-buffer (make-bytes buffer-size)) - (define repl-thread (thread (lambda () - ;; TODO: thread username through - (repl-shell "unknown" c2s-in s2c-out)))) + (define repl-thread (thread (lambda () (repl-shell user-name c2s-in s2c-out)))) (transition state (ch-do send-feedback inbound-stream (channel-stream-ok)) (role 'thread-death-listener (topic-subscriber (cons (thread-dead-evt repl-thread) (wild))) diff --git a/ssh-session.rkt b/ssh-session.rkt index e880cb8..f60a97c 100644 --- a/ssh-session.rkt +++ b/ssh-session.rkt @@ -72,7 +72,8 @@ is-server? local-id remote-id - session-id) ;; starts off #f until initial keying + session-id ;; starts off #f until initial keying + application-boot) ;; used when authentication completes #:transparent) ;; Generic inputs into the exchange-hash part of key @@ -485,7 +486,12 @@ SSH_MSG_USERAUTH_REQUEST (lambda (packet message conn) ;; RFC4252 section 5.1 page 6 - conn)))))] + conn)))) + (lambda (conn) + (transition conn + (spawn (nested-vm 'ssh-application-vm ((connection-application-boot conn) user-name)) + #:exit-signal? #t + #:debug-name 'ssh-application-vm))))] [else (transition conn (send-message (outbound-packet (ssh-msg-userauth-failure '(none) #f))))])) @@ -860,11 +866,8 @@ (case session-role ((client) #f) ((server) #t)) local-identification-string peer-identification-string - #f) - - (spawn (nested-vm 'ssh-application-vm application-boot) - #:exit-signal? #t - #:debug-name 'ssh-application-vm) + #f + application-boot) (role 'rekey-waiter (topic-subscriber (timer-expired 'rekey-timer (wild))) #:state conn