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

Support cooker prompts in ssh-service.

This commit is contained in:
Tony Garnock-Jones 2011-10-27 15:24:34 -04:00
parent fe0f7c7fe0
commit ad7b120bf6
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ssh-service.rkt
View File

@ -161,10 +161,12 @@
;; PTY-based/shell-like services
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (pty-ssh-server-session handle shell-callback)
(raw-ssh-server-session/session handle (pty-ssh-server-session-callback shell-callback)))
(define (pty-ssh-server-session handle shell-callback #:prompt [prompt ""])
(raw-ssh-server-session/session handle
(pty-ssh-server-session-callback shell-callback
#:prompt prompt)))
(define (pty-ssh-server-session-callback shell-callback)
(define (pty-ssh-server-session-callback shell-callback #:prompt [prompt ""])
(lambda (username oob-ch in out)
(define (base-eh loop)
(match-lambda
@ -188,7 +190,7 @@
(match-lambda
(`(request (#"pty-req" ,_) ,k)
(k 'ok)
(define-values (cooked-in cooked-out) (cook-io in out ""))
(define-values (cooked-in cooked-out) (cook-io in out prompt))
(configure-shell cooked-in cooked-out))
(`(request (#"shell" ,_) ,k)
(k 'ok)
@ -197,10 +199,10 @@
(configure-shell in out)))
(define (tcp-pty-ssh-server server-socket shell-callback)
(define (tcp-pty-ssh-server server-socket shell-callback #:prompt [prompt ""])
(let loop ()
(define-values (i o) (tcp-accept server-socket))
(standard-thread
(lambda ()
(pty-ssh-server-session (ssh-session 'server i o) shell-callback)))
(pty-ssh-server-session (ssh-session 'server i o) shell-callback #:prompt prompt)))
(loop)))