Thread username through.

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)))

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