100 lines
2.7 KiB
Racket
100 lines
2.7 KiB
Racket
#lang racket/base
|
|
;; (Temporary) example client and server
|
|
|
|
(require racket/tcp)
|
|
(require racket/pretty)
|
|
(require racket/match)
|
|
(require racket/class)
|
|
(require racket/port)
|
|
(require racket/sandbox)
|
|
|
|
(require "conversation.rkt")
|
|
(require "ssh-numbers.rkt")
|
|
(require "ssh-session.rkt")
|
|
(require "standard-thread.rkt")
|
|
|
|
(require "cook-port.rkt")
|
|
|
|
(define (t-client)
|
|
(let-values (((i o) (tcp-connect "localhost"
|
|
2323
|
|
;;22
|
|
)))
|
|
(let ((api (ssh-session 'client i o)))
|
|
(printf "Got API ~v\n" api)
|
|
(semaphore-wait (make-semaphore 0)))))
|
|
|
|
(define (make-repl-channel-main username)
|
|
(lambda (oob-ch in out)
|
|
(define (run-shell in out)
|
|
(define reader-thread
|
|
(thread
|
|
(lambda ()
|
|
(fprintf out "Hello, ~a.\n" username)
|
|
(parameterize ((current-input-port in)
|
|
(current-output-port out)
|
|
(current-error-port out)
|
|
(sandbox-input in)
|
|
(sandbox-output out)
|
|
(sandbox-error-output out)
|
|
(current-namespace (make-empty-namespace)))
|
|
(parameterize ((current-eval (make-evaluator 'racket/base)))
|
|
(read-eval-print-loop))
|
|
(fprintf out "\nGoodbye!\n")
|
|
(close-input-port in)
|
|
(close-output-port out)))))
|
|
(let loop ()
|
|
(sync (handle-evt oob-ch
|
|
(match-lambda
|
|
(`(notify ,type ,data)
|
|
(log-info (format "repl-channel: notify ~v ~v" type data))
|
|
(loop))
|
|
(`(request ,other ,k)
|
|
(log-info (format "repl-channel: request ~v" other))
|
|
(k 'error)
|
|
(loop))))
|
|
(handle-evt reader-thread void))))
|
|
|
|
(let update-channels ((in in) (out out))
|
|
(let loop ()
|
|
(sync (handle-evt oob-ch
|
|
(match-lambda
|
|
(`(notify ,type ,data)
|
|
(log-info (format "repl-channel: notify ~v ~v" type data))
|
|
(loop))
|
|
(`(request (#"pty-req" ,_) ,k)
|
|
(k 'ok)
|
|
(define-values (cooked-in cooked-out) (cook-io in out ""))
|
|
(update-channels cooked-in cooked-out))
|
|
(`(request (#"shell" ,_) ,k)
|
|
(k 'ok)
|
|
(run-shell in out))
|
|
(`(request ,other ,k)
|
|
(log-info (format "repl-channel: request ~v" other))
|
|
(k 'error)
|
|
(loop)))))))))
|
|
|
|
(define (t-server)
|
|
(define s (tcp-listen 2322 4 #t "localhost"))
|
|
(printf "Accepting...\n")
|
|
(let loop ()
|
|
(let-values (((i o) (tcp-accept s)))
|
|
(standard-thread
|
|
(lambda ()
|
|
(simple-ssh-server (ssh-session 'server i o)
|
|
(lambda (username channel-type extra-request-data state)
|
|
(match channel-type
|
|
(#"session"
|
|
(values `(ok ,(make-repl-channel-main username) #"")
|
|
state))
|
|
(else
|
|
(values `(error ,SSH_OPEN_UNKNOWN_CHANNEL_TYPE
|
|
"Unknown channel type")
|
|
state))))
|
|
'no-state)))
|
|
(loop))))
|
|
|
|
(if (getenv "clientmode")
|
|
(t-client)
|
|
(t-server))
|