syndicate-lang
/
racket-ssh-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Dumbest possible echo server.

This commit is contained in:
Tony Garnock-Jones 2012-07-03 15:50:39 -04:00
parent 7838272680
commit ab5b1850d0
1 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
new-server.rkt
View File

@ -81,12 +81,28 @@
(define (repl-instance cname) (define (repl-instance cname)
(define inbound-stream (channel-stream-name #t cname)) (define inbound-stream (channel-stream-name #t cname))
(define outbound-stream (channel-stream-name #f cname)) (define outbound-stream (channel-stream-name #f cname))
(define (ch-do action-ctor stream body)
(at-meta-level (action-ctor (channel-message stream body))))
(define (handle-channel-message state body) (define (handle-channel-message state body)
(match body (match body
[(channel-stream-request #"pty-req" _) [(channel-stream-request #"pty-req" _)
(transition state (ch-do send-feedback inbound-stream (channel-stream-ok)))]
[(channel-stream-notify #"env" _)
;; Don't care
state]
[(channel-stream-request #"shell" _)
(transition state (transition state
(at-meta-level (send-message (channel-message inbound-stream (channel-stream-ok)) (ch-do send-feedback inbound-stream (channel-stream-ok))
'subscriber)))] (ch-do send-message outbound-stream (channel-stream-data #"Welcome!\r\n")))]
[(or (channel-stream-data #"\4") ;; C-d a.k.a EOT
(channel-stream-eof))
(transition state
(ch-do send-message outbound-stream (channel-stream-data #"Goodbye!\r\n"))
(kill))]
[(channel-stream-data bs)
(transition state
(ch-do send-feedback inbound-stream (channel-stream-credit (bytes-length bs)))
(ch-do send-message outbound-stream (channel-stream-data bs)))]
[m [m
(write `(channel inbound ,m)) (newline) (write `(channel inbound ,m)) (newline)
state])) state]))
@ -96,13 +112,11 @@
(at-meta-level (at-meta-level
(role 'input (topic-subscriber (channel-message inbound-stream (wild))) (role 'input (topic-subscriber (channel-message inbound-stream (wild)))
#:state state #:state state
#:on-presence (transition state (at-meta-level #:on-presence (transition state
(send-message (ch-do send-feedback inbound-stream (channel-stream-config
(channel-message inbound-stream (default-packet-limit)
(channel-stream-config #""))
(default-packet-limit) (ch-do send-feedback inbound-stream (channel-stream-credit 64)))
#""))
'subscriber)))
[(channel-message _ body) [(channel-message _ body)
(handle-channel-message state body)])) (handle-channel-message state body)]))
(at-meta-level (at-meta-level