Better factoring of the identification line handling

syndicate-ssh/new-server.rkt

@@ -36,76 +36,42 @@
 
 ;;---------------------------------------------------------------------------
 
-(define (check-remote-identification! peer-identification-string)
-  (define required-peer-identification-regex #rx"^SSH-2\\.0-.*")
-  ;; Each identification string is both a cleartext indicator that
-  ;; we've reached some notion of the right place and also input to
-  ;; the hash function used during D-H key exchange.
-  (when (not (regexp-match required-peer-identification-regex
-			   peer-identification-string))
-    (error 'ssh-session
-	   "Invalid peer identification string ~v"
-	   peer-identification-string)))
-
 (define (session ground-ds source sink)
-  (define local-identification #"SSH-2.0-RacketSSH_0.0")
+  (on-stop (log-info "Session VM for ~a closed" source))
+  (actor-group
+    #:link? #t
+    (define conn-ds (dataspace #:name (gensym 'conn-ds)))
 
-  (define id-line-reader-facet
+    (define local-identification #"SSH-2.0-RacketSSH_0.0")
-    (react
-      (on-start (send-line sink local-identification)
-                (send-lines-credit source 1 (LineMode-crlf)))
-      (handle-connection source sink
-                         #:initial-credit #f
-                         #:on-data (lambda (remote-identification _mode)
-                                     (check-remote-identification! remote-identification)
-                                     (send! session-vm-factory remote-identification)))))
 
-  (define transfers-remaining 2)
+    (spawn #:name 'reader (ssh-reader conn-ds source))
-  (define transfer-control
+    (spawn #:name 'writer (ssh-writer conn-ds sink local-identification))
-    (object #:name 'transfer-control
-            [#:message 'transfer-control
-             (set! transfers-remaining (- transfers-remaining 1))
-             (when (zero? transfers-remaining) (stop-facet id-line-reader-facet))]))
 
-  (define session-vm-factory
+    (at conn-ds
-    (object
+      (once
-      #:name 'session-vm-factory
+       [(message (ssh-identification-line $remote-identification))
-      [#:message remote-identification
+        (if (not (regexp-match #rx"^SSH-2\\.0-.*" remote-identification))
-       (on-stop (log-info "Session VM for ~a closed" source))
+            (begin
-       (actor-group
+              (log-error "Invalid peer identification string ~v" remote-identification)
-         #:link? #t
+              (stop-actor-system))
-         (define conn-ds (dataspace #:name (gensym 'conn-ds)))
+            (begin
+              (send! (inbound-credit 1))
+              (spawn #:name 'session
+                     (ssh-session conn-ds
+                                  ground-ds
+                                  local-identification
+                                  remote-identification
+                                  'server))))])
 
-         (spawn #:name 'reader (ssh-reader conn-ds source transfer-control))
+      (during (SshAuthenticatedUser $user-name #"ssh-connection")
-         (spawn #:name 'writer (ssh-writer conn-ds sink transfer-control))
+        (run-repl-instance conn-ds user-name))
 
-         ;; Wait for the reader and writer get started, then tell the reader
+      (on (asserted (protocol-error $reason-code $message _ $originated-at-peer?))
-         ;; we are ready for a single packet and spawn the session manager.
+        (when (not originated-at-peer?)
-         (react
+          (send! (outbound-packet (ssh-msg-disconnect reason-code
-           (at conn-ds
+                                                      (string->bytes/utf-8 message)
-             (stop-on (asserted (Observe (:pattern (inbound-credit ,_)) _))
+                                                      #""))))
-               (send! (inbound-credit 1))
+        (sync! conn-ds (stop-actor-system))))))
-
-               (spawn
-                 #:name 'session
-                 (ssh-session conn-ds
-                              ground-ds
-                              local-identification
-                              remote-identification
-                              'server)))))
-
-         (at conn-ds
-           (during (SshAuthenticatedUser $user-name #"ssh-connection")
-             (run-repl-instance conn-ds user-name))
-
-           (on (asserted (protocol-error $reason-code $message _ $originated-at-peer?))
-             (when (not originated-at-peer?)
-               (send! (outbound-packet (ssh-msg-disconnect reason-code
-                                                           (string->bytes/utf-8 message)
-                                                           #""))))
-             (sync! conn-ds (stop-actor-system)))))]))
-
-  (void))
 
 ;;---------------------------------------------------------------------------
 

syndicate-ssh/ssh-message-types.rkt

@@ -13,7 +13,8 @@
          t:repeat
          t:padding)
 
-(provide (struct-out ssh-msg-kexinit)
+(provide (struct-out ssh-identification-line)
+         (struct-out ssh-msg-kexinit)
 	 (struct-out ssh-msg-kexdh-init)
 	 (struct-out ssh-msg-kexdh-reply)
 	 (struct-out ssh-msg-disconnect)
@@ -252,6 +253,8 @@
                             (bytes #x00 #x00 #x00 #x05
                                    #xff #x21 #x52 #x41 #x11)) 'ok)))
 
+(struct ssh-identification-line (bytes) #:prefab)
+
 (define-ssh-message-type ssh-msg-kexinit SSH_MSG_KEXINIT
      ((byte 16)    cookie)
      (name-list    kex_algorithms)

syndicate-ssh/ssh-transport.rkt

@@ -260,13 +260,18 @@
 ;; Encrypted Packet Input
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (ssh-reader conn-ds source transfer-control)
+(define (ssh-reader conn-ds source)
   (define input-handler #f)
   (define (update-input-handler #:on-data proc) (set! input-handler proc))
   (make-sink #:initial-source source
              #:name 'ssh-in
              #:on-data (lambda (data mode) (input-handler data mode)))
-  (send! transfer-control 'transfer-control)
+
+  (on-start (send-lines-credit source 1 (LineMode-crlf)))
+  (update-input-handler
+   #:on-data (lambda (remote-identification _mode)
+               (send! conn-ds (ssh-identification-line remote-identification))
+               (update-input-handler #:on-data handle-packet-header)))
 
   (define packet-size-limit (default-packet-limit))
   (define sequence-number 0)
@@ -331,8 +336,6 @@
     (set! remaining-credit (- remaining-credit 1))
     (issue-credit))
 
-  (update-input-handler #:on-data handle-packet-header)
-
   (at conn-ds
     (on (message (inbound-credit $amount))
       (set! remaining-credit (+ remaining-credit amount))
@@ -345,13 +348,13 @@
 ;; Encrypted Packet Output
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (ssh-writer conn-ds sink transfer-control)
+(define (ssh-writer conn-ds sink local-identification)
   (define config initial-crypto-configuration)
   (define sequence-number 0)
 
+  (on-start (send-line sink local-identification))
   (make-source #:initial-sink sink
                #:name 'ssh-out)
-  (send! transfer-control 'transfer-control)
 
   (define (block-size)
     (supported-cipher-block-size (crypto-configuration-cipher-description config)))