From ad7b120bf6fe3c2f006bcf12619264419edb6a18 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 27 Oct 2011 15:24:34 -0400 Subject: [PATCH] Support cooker prompts in ssh-service. --- ssh-service.rkt | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/ssh-service.rkt b/ssh-service.rkt index e52511b..5912093 100644 --- a/ssh-service.rkt +++ b/ssh-service.rkt @@ -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)))