Extract identification string before switching to packet mode

new-server.rkt

@@ -13,47 +13,74 @@
 (define server-addr (tcp-listener 2322))
 
 (define (connection-handler local-addr remote-addr)
+  (define local-identification #"SSH-2.0-RacketSSH_0.0")
   (nested-vm
    (list 'ssh-session-vm remote-addr)
-   (transition 'running
-     (at-meta-level
-      (send-message (tcp-channel local-addr remote-addr #"SSH-2.0-RacketSSH_0.0\r\n")))
-     (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
-      (role 'identification-handler (topic-subscriber %%%
+   (lambda (nested-boot-pid)
+     (transition 'running
 
-     (spawn (ssh-reader local-addr remote-addr) #:debug-name 'ssh-reader)
-     (spawn (ssh-writer local-addr remote-addr) #:debug-name 'ssh-writer)
-     (yield #:state state
-       (transition state (send-message (inbound-credit 1))))
-     (role 'crash-listener
-	 (set (topic-subscriber (wild) #:virtual? #t)
-	      (topic-publisher (wild) #:virtual? #t))
-       #: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.
-       (if (eq? state 'running)
-	   (if (and (exn:fail:contract:protocol? reason)
-		    (not (exn:fail:contract:protocol-originated-at-peer? reason)))
-	       (transition 'error-packet-sent
-		 (send-message (outbound-packet (ssh-msg-disconnect
-						 (exn:fail:contract:protocol-reason-code reason)
-						 (string->bytes/utf-8 (exn-message reason))
-						 #"")))
-		 (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]))))
+       ;; Issue identification string.
+       (at-meta-level
+	(send-message (tcp-channel local-addr
+				   remote-addr
+				   (bytes-append local-identification #"\r\n"))))
+
+       ;; Expect identification string, then update (!) our inbound
+       ;; subscription handler to switch to packet mode.
+
+       (at-meta-level (send-tcp-mode remote-addr local-addr 'lines))
+       (at-meta-level (send-tcp-credit remote-addr local-addr 1))
+
+       (spawn
+	(transition 'handshake-is-stateless
+	  (at-meta-level
+	   (role 'socket-reader (topic-subscriber (tcp-channel remote-addr local-addr (wild)))
+	     #:state state
+	     [(tcp-channel _ _ (? eof-object?))
+	      (transition state (kill))]
+	     [(tcp-channel _ _ (? bytes? remote-identification))
+	      ;; First, set the incoming mode to bytes. Then
+	      ;; initialise the reader, switching to packet-reading
+	      ;; mode. Finally, spawn the remaining processes and
+	      ;; issue the initial credit to the reader.
+	      (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)
+		;; Wait for a cycle to let the reader and writer get
+		;; started, then tell the reader we are ready for a
+		;; single packet.
+		(yield #:state state
+		  (transition state (send-message (inbound-credit 1)))))])))
+	#:debug-name 'ssh-reader)
+
+       (role 'crash-listener
+	   (set (topic-subscriber (wild) #:virtual? #t)
+		(topic-publisher (wild) #:virtual? #t))
+	 #: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.
+	 (if (eq? state 'running)
+	     (if (and (exn:fail:contract:protocol? reason)
+		      (not (exn:fail:contract:protocol-originated-at-peer? reason)))
+		 (transition 'error-packet-sent
+		   (send-message (outbound-packet (ssh-msg-disconnect
+						   (exn:fail:contract:protocol-reason-code reason)
+						   (string->bytes/utf-8 (exn-message reason))
+						   #"")))
+		   (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])))))
 
 (ground-vm
  (transition 'no-state

ssh-transport.rkt

@@ -300,6 +300,8 @@
 							    hmac-description)
 				      sequence-number
 				      remaining-credit))
+       [(tcp-channel _ _ (? eof-object?))
+	(transition state (kill))]
        [(tcp-channel _ _ (? bytes? encrypted-packet))
 	(define block-size (supported-cipher-block-size cipher-description))
 	(define first-block-size block-size)