syndicate-lang
/
syndicate-ssh
forked from syndicate-lang/marketplace-ssh-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Better factoring of the identification line handling

This commit is contained in:
Tony Garnock-Jones 2021-06-19 12:35:36 +02:00
parent 3daae80a25
commit 410c53ebda
3 changed files with 43 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
syndicate-ssh/new-server.rkt
View File

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

5
syndicate-ssh/ssh-message-types.rkt
View File

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

15
syndicate-ssh/ssh-transport.rkt
View File

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