86 lines
2.3 KiB
Racket
86 lines
2.3 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 "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 prompt "RacketSSH> ")
|
|
|
|
(define (make-repl-channel-main username)
|
|
(lambda (oob-ch in out)
|
|
(fprintf out "Hello, ~a.\r\n~a" username prompt)
|
|
(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 (#"shell" ,_) ,k)
|
|
(k 'ok)
|
|
(loop))
|
|
(`(request (#"pty-req" ,_) ,k)
|
|
(k 'ok)
|
|
(define-values (cooked-in cooked-out) (cook-io in out prompt))
|
|
(update-channels cooked-in cooked-out))
|
|
(`(request ,other ,k)
|
|
(log-info (format "repl-channel: request ~v" other))
|
|
(k 'error)
|
|
(loop))))
|
|
#;(handle-evt (read-bytes-evt 10000 in)
|
|
(lambda (buf)
|
|
(write-bytes buf out)
|
|
(loop)))
|
|
(handle-evt (read-line-evt in 'any)
|
|
(lambda (line)
|
|
;;(log-info (format "received ~v" line))
|
|
(if (eof-object? line)
|
|
(begin (fprintf out "\r\nGoodbye\r\n")
|
|
'done)
|
|
(begin (fprintf out "You said ~s\r\n" line)
|
|
(write-string prompt out)
|
|
(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))
|