diff --git a/new-server.rkt b/new-server.rkt index 7a82f6a..db268b6 100644 --- a/new-server.rkt +++ b/new-server.rkt @@ -7,6 +7,7 @@ (require "ssh-numbers.rkt") (require "ssh-transport.rkt") (require "ssh-session.rkt") +(require "ssh-channel.rkt") (require "ssh-message-types.rkt") (require "ssh-exceptions.rkt") (require "os2-support.rkt") @@ -25,8 +26,67 @@ peer-identification-string))) (define (repl-boot self-pid) - (write 'repl-boot) (newline) (flush-output) - 'no-repl-state) + (transition 'no-repl-state + (role 'spy (or (topic-subscriber (wild) #:virtual? #t) + (topic-publisher (wild) #:virtual? #t)) + #:state state + [message + (write `(APP ,message)) + (newline) + (flush-output) + state]) + (at-meta-level + (role 'channel-listener (topic-subscriber (channel-message (channel-stream-name #t (wild)) + (wild))) + #:state state + #:topic t + #:on-presence + (if (topic-virtual? t) + state + (match t + [(topic _ (channel-message (channel-stream-name _ cname) _) _) + (transition state (spawn (repl-instance cname) #:debug-name cname))])))))) + +(define (repl-instance cname) + (define inbound-stream (channel-stream-name #t cname)) + (define outbound-stream (channel-stream-name #f cname)) + (define (handle-channel-message state body) + (match body + [(channel-stream-request #"pty-req" _) + (transition state + (at-meta-level (send-message (channel-message inbound-stream (channel-stream-ok)) + 'subscriber)))] + [m + (write `(channel inbound ,m)) (newline) + state])) + (match (channel-name-type cname) + [#"session" + (transition 'no-instance-state + (at-meta-level + (role 'input (topic-subscriber (channel-message inbound-stream (wild))) + #:state state + #:on-presence (transition state (at-meta-level + (send-message + (channel-message inbound-stream + (channel-stream-config + (default-packet-limit) + #"")) + 'subscriber))) + [(channel-message _ body) + (handle-channel-message state body)])) + (at-meta-level + (role 'output (topic-publisher (channel-message outbound-stream (wild))) + #:state state + [m + (write `(channel outbound ,cname ,m)) (newline) + state])))] + [type + (transition 'no-instance-state + (at-meta-level (send-message + (channel-message outbound-stream + (channel-stream-open-failure + SSH_OPEN_UNKNOWN_CHANNEL_TYPE + (bytes-append #"Unknown channel type " type))))))])) (define (connection-handler local-addr remote-addr) (define local-identification #"SSH-2.0-RacketSSH_0.0") @@ -113,7 +173,7 @@ (transition 'no-state (spawn (timer-driver 'timer-driver)) (spawn tcp-driver #:debug-name 'tcp-driver) - ;;(spawn tcp-spy #:debug-name 'tcp-spy) + (spawn tcp-spy #:debug-name 'tcp-spy) (spawn (transition 'no-state (role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild)) diff --git a/ssh-session.rkt b/ssh-session.rkt index ef4ab0a..226a523 100644 --- a/ssh-session.rkt +++ b/ssh-session.rkt @@ -630,13 +630,13 @@ (! conn (ssh-msg-channel-open (channel-name-type cname) (ssh-channel-local-ref ch) 0 - (default-packet-limit) + maximum-packet-size extra-data)) ;; This must be intended to form the SSH_MSG_CHANNEL_OPEN_CONFIRMATION. (! conn (ssh-msg-channel-open-confirmation remote-ref (ssh-channel-local-ref ch) 0 - (default-packet-limit) + maximum-packet-size extra-data)))] [(channel-stream-credit count) (! conn (ssh-msg-channel-window-adjust remote-ref count))]