Start of channel-listener in application
This commit is contained in:
parent
9e7fc9bbbd
commit
1058f0e96f
|
@ -7,6 +7,7 @@
|
||||||
(require "ssh-numbers.rkt")
|
(require "ssh-numbers.rkt")
|
||||||
(require "ssh-transport.rkt")
|
(require "ssh-transport.rkt")
|
||||||
(require "ssh-session.rkt")
|
(require "ssh-session.rkt")
|
||||||
|
(require "ssh-channel.rkt")
|
||||||
(require "ssh-message-types.rkt")
|
(require "ssh-message-types.rkt")
|
||||||
(require "ssh-exceptions.rkt")
|
(require "ssh-exceptions.rkt")
|
||||||
(require "os2-support.rkt")
|
(require "os2-support.rkt")
|
||||||
|
@ -25,8 +26,67 @@
|
||||||
peer-identification-string)))
|
peer-identification-string)))
|
||||||
|
|
||||||
(define (repl-boot self-pid)
|
(define (repl-boot self-pid)
|
||||||
(write 'repl-boot) (newline) (flush-output)
|
(transition 'no-repl-state
|
||||||
'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 (connection-handler local-addr remote-addr)
|
||||||
(define local-identification #"SSH-2.0-RacketSSH_0.0")
|
(define local-identification #"SSH-2.0-RacketSSH_0.0")
|
||||||
|
@ -113,7 +173,7 @@
|
||||||
(transition 'no-state
|
(transition 'no-state
|
||||||
(spawn (timer-driver 'timer-driver))
|
(spawn (timer-driver 'timer-driver))
|
||||||
(spawn tcp-driver #:debug-name 'tcp-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
|
(spawn (transition 'no-state
|
||||||
(role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild))
|
(role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild))
|
||||||
|
|
|
@ -630,13 +630,13 @@
|
||||||
(! conn (ssh-msg-channel-open (channel-name-type cname)
|
(! conn (ssh-msg-channel-open (channel-name-type cname)
|
||||||
(ssh-channel-local-ref ch)
|
(ssh-channel-local-ref ch)
|
||||||
0
|
0
|
||||||
(default-packet-limit)
|
maximum-packet-size
|
||||||
extra-data))
|
extra-data))
|
||||||
;; This must be intended to form the SSH_MSG_CHANNEL_OPEN_CONFIRMATION.
|
;; This must be intended to form the SSH_MSG_CHANNEL_OPEN_CONFIRMATION.
|
||||||
(! conn (ssh-msg-channel-open-confirmation remote-ref
|
(! conn (ssh-msg-channel-open-confirmation remote-ref
|
||||||
(ssh-channel-local-ref ch)
|
(ssh-channel-local-ref ch)
|
||||||
0
|
0
|
||||||
(default-packet-limit)
|
maximum-packet-size
|
||||||
extra-data)))]
|
extra-data)))]
|
||||||
[(channel-stream-credit count)
|
[(channel-stream-credit count)
|
||||||
(! conn (ssh-msg-channel-window-adjust remote-ref count))]
|
(! conn (ssh-msg-channel-window-adjust remote-ref count))]
|
||||||
|
|
Loading…
Reference in New Issue