From 410c53ebda07b56d14dd5a20a60a2c65fb31bbe7 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 19 Jun 2021 12:35:36 +0200 Subject: [PATCH] Better factoring of the identification line handling --- syndicate-ssh/new-server.rkt | 94 +++++++++-------------------- syndicate-ssh/ssh-message-types.rkt | 5 +- syndicate-ssh/ssh-transport.rkt | 15 +++-- 3 files changed, 43 insertions(+), 71 deletions(-) diff --git a/syndicate-ssh/new-server.rkt b/syndicate-ssh/new-server.rkt index 999d73e..1d6707d 100644 --- a/syndicate-ssh/new-server.rkt +++ b/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 - (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 local-identification #"SSH-2.0-RacketSSH_0.0") - (define transfers-remaining 2) - (define transfer-control - (object #:name 'transfer-control - [#:message 'transfer-control - (set! transfers-remaining (- transfers-remaining 1)) - (when (zero? transfers-remaining) (stop-facet id-line-reader-facet))])) + (spawn #:name 'reader (ssh-reader conn-ds source)) + (spawn #:name 'writer (ssh-writer conn-ds sink local-identification)) - (define session-vm-factory - (object - #:name 'session-vm-factory - [#:message remote-identification - (on-stop (log-info "Session VM for ~a closed" source)) - (actor-group - #:link? #t - (define conn-ds (dataspace #:name (gensym 'conn-ds))) + (at conn-ds + (once + [(message (ssh-identification-line $remote-identification)) + (if (not (regexp-match #rx"^SSH-2\\.0-.*" remote-identification)) + (begin + (log-error "Invalid peer identification string ~v" remote-identification) + (stop-actor-system)) + (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)) - (spawn #:name 'writer (ssh-writer conn-ds sink transfer-control)) + (during (SshAuthenticatedUser $user-name #"ssh-connection") + (run-repl-instance conn-ds user-name)) - ;; Wait for the reader and writer get started, then tell the reader - ;; we are ready for a single packet and spawn the session manager. - (react - (at conn-ds - (stop-on (asserted (Observe (:pattern (inbound-credit ,_)) _)) - (send! (inbound-credit 1)) - - (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)) + (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)))))) ;;--------------------------------------------------------------------------- diff --git a/syndicate-ssh/ssh-message-types.rkt b/syndicate-ssh/ssh-message-types.rkt index f5453a4..40241ed 100644 --- a/syndicate-ssh/ssh-message-types.rkt +++ b/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) diff --git a/syndicate-ssh/ssh-transport.rkt b/syndicate-ssh/ssh-transport.rkt index e278fc2..9e3351b 100644 --- a/syndicate-ssh/ssh-transport.rkt +++ b/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)))