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

Fix EOF- and close-negotiation; switch API for closing; connect sandbox repl.

This commit is contained in:
Tony Garnock-Jones 2011-10-26 19:16:16 -04:00
parent 9437241481
commit 7ad6291124
2 changed files with 104 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
repl-server.rkt
View File

@ -6,6 +6,7 @@
(require racket/match) (require racket/match)
(require racket/class) (require racket/class)
(require racket/port) (require racket/port)
(require racket/sandbox)
(require "conversation.rkt") (require "conversation.rkt")
(require "ssh-numbers.rkt") (require "ssh-numbers.rkt")
@ -23,11 +24,37 @@
(printf "Got API ~v\n" api) (printf "Got API ~v\n" api)
(semaphore-wait (make-semaphore 0))))) (semaphore-wait (make-semaphore 0)))))
(define prompt "RacketSSH> ")
(define (make-repl-channel-main username) (define (make-repl-channel-main username)
(lambda (oob-ch in out) (lambda (oob-ch in out)
(fprintf out "Hello, ~a.\r\n~a" username prompt) (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 update-channels ((in in) (out out))
(let loop () (let loop ()
(sync (handle-evt oob-ch (sync (handle-evt oob-ch
@ -35,30 +62,17 @@
(`(notify ,type ,data) (`(notify ,type ,data)
(log-info (format "repl-channel: notify ~v ~v" type data)) (log-info (format "repl-channel: notify ~v ~v" type data))
(loop)) (loop))
(`(request (#"shell" ,_) ,k)
(k 'ok)
(loop))
(`(request (#"pty-req" ,_) ,k) (`(request (#"pty-req" ,_) ,k)
(k 'ok) (k 'ok)
(define-values (cooked-in cooked-out) (cook-io in out prompt)) (define-values (cooked-in cooked-out) (cook-io in out ""))
(update-channels cooked-in cooked-out)) (update-channels cooked-in cooked-out))
(`(request (#"shell" ,_) ,k)
(k 'ok)
(run-shell in out))
(`(request ,other ,k) (`(request ,other ,k)
(log-info (format "repl-channel: request ~v" other)) (log-info (format "repl-channel: request ~v" other))
(k 'error) (k 'error)
(loop)))) (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 (t-server)
(define s (tcp-listen 2322 4 #t "localhost")) (define s (tcp-listen 2322 4 #t "localhost"))

138
ssh-session.rkt
View File

@ -793,7 +793,7 @@
(match message (match message
((arrived _) ((arrived _)
conn) conn)
((and departure (departed who why)) ((and departure (departed _ _))
(disconnect-with-error/local-info (disconnect-with-error/local-info
departure departure
SSH_DISCONNECT_BY_APPLICATION SSH_DISCONNECT_BY_APPLICATION
@ -832,6 +832,9 @@
((says _ `(data ,bits) _) ((says _ `(data ,bits) _)
(write-message!/flush (ssh-msg-channel-data your-ref bits) conn) (write-message!/flush (ssh-msg-channel-data your-ref bits) conn)
conn) conn)
((says _ `(eof) _)
(write-message!/flush (ssh-msg-channel-eof your-ref) conn)
conn)
((says _ (rpc-reply id m) _) ((says _ (rpc-reply id m) _)
(finish-channel-request ch conn id m)))))) (finish-channel-request ch conn id m))))))
@ -944,76 +947,70 @@
;; Session API ;; Session API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (run-channel oob-ch app-out-port in out handle channel-thread) (define (run-channel oob-ch app-out-port app-in-port in out handle)
(define (close-in) (define (close-in) (when (not (port-closed? in)) (close-input-port in)))
(when (not (port-closed? in)) (define (close-out) (when (not (port-closed? out)) (close-output-port out)))
(close-input-port in)))
(define (close-out)
(when (not (port-closed? out))
(close-output-port out)))
(define (close-ports) (define (close-ports)
(close-in) (close-in)
(close-out) (close-out)
'done) 'closed)
(let loop ((oob-queue (make-queue)) (let loop ((oob-queue (make-queue))
(remaining-credit 0)) (remaining-credit 0))
(define channel-thread-dead (thread-dead? channel-thread)) (when (port-closed? app-in-port)
(sync (if (queue-empty? oob-queue) ;; The application has stopped listening. Ensure we stop sending, just as if an EOF
never-evt ;; was received from the remote.
(let-values (((first rest) (dequeue oob-queue))) (close-out))
(handle-evt (channel-put-evt oob-ch first) (define finished-reading? (port-closed? in))
(lambda (dummy) (loop rest remaining-credit))))) (define finished-writing? (port-closed? out))
(if channel-thread-dead (if (and finished-reading? finished-writing?)
never-evt 'closed
(handle-evt (thread-dead-evt channel-thread) (sync (if (queue-empty? oob-queue)
(lambda (dummy) never-evt
(when (not (port-closed? app-out-port)) (let-values (((first rest) (dequeue oob-queue)))
;; If the thread died without closing its output-port, do (handle-evt (channel-put-evt oob-ch first)
;; that here. That way we get to drain the port before (lambda (dummy) (loop rest remaining-credit)))))
;; terminating ourselves. (if finished-reading?
(close-output-port app-out-port)) never-evt
(loop oob-queue remaining-credit)))) (if (positive? remaining-credit)
(if (port-closed? in) (let ((buffer (make-bytes (min (channel-io-transfer-buffer-size)
(if channel-thread-dead remaining-credit))))
(handle-evt always-evt (lambda (dummy) (close-ports))) (handle-evt (read-bytes-avail!-evt buffer in)
never-evt) (lambda (count)
(if (positive? remaining-credit) (if (eof-object? count)
(let ((buffer (make-bytes (min (channel-io-transfer-buffer-size) (begin (send handle say `(eof))
remaining-credit)))) (close-in)
(handle-evt (read-bytes-avail!-evt buffer in) (loop oob-queue remaining-credit))
(lambda (count) (let ((data (sub-bit-string buffer 0 (* 8 count))))
(if (eof-object? count) (begin (send handle say `(data ,data))
(begin (close-in) (loop oob-queue (- remaining-credit count))))))))
(if channel-thread-dead never-evt))
(close-ports) (handle-evt (send handle listen-evt)
(loop oob-queue remaining-credit))) (match-lambda
(begin (send handle say ((arrived _)
`(data ,(sub-bit-string buffer 0 (* 8 count)))) (loop oob-queue remaining-credit))
(loop oob-queue (- remaining-credit count))))))) ((and departure (departed who why))
never-evt)) (send handle depart departure)
(handle-evt (send handle listen-evt) (close-ports))
(match-lambda ((says _ (credit _ amount) _)
((arrived _) (loop oob-queue (+ remaining-credit amount)))
(loop oob-queue remaining-credit)) ((says _ `(data ,data) _)
((departed _ _) (when (not finished-writing?) (write-bytes data out))
(close-ports)) ;; TODO: propagate backpressure through pipes
((says _ (credit _ amount) _) (send handle say (credit 'session (bytes-length data)))
(loop oob-queue (+ remaining-credit amount))) (loop oob-queue remaining-credit))
((says _ `(data ,data) _) ((says _ `(eof) _)
(write-bytes data out) (close-out)
;; TODO: propagate backpressure through pipes (loop oob-queue remaining-credit))
(send handle say (credit 'session (bytes-length data))) ((says _ (and notification `(notify ,type ,data)) _)
(loop oob-queue remaining-credit)) (loop (enqueue oob-queue notification) remaining-credit))
((says _ (and notification `(notify ,type ,data)) _) ((says _ (rpc-request reply-to id message) _)
(loop (enqueue oob-queue notification) remaining-credit)) (loop (enqueue oob-queue
((says _ (rpc-request reply-to id message) _) `(request ,message
(loop (enqueue oob-queue ,(lambda (answer)
`(request ,message (send handle say
,(lambda (answer) (rpc-reply id answer)
(send handle say reply-to))))
(rpc-reply id answer) remaining-credit))))))))
reply-to))))
remaining-credit)))))))
(define (start-app-channel channel-main) (define (start-app-channel channel-main)
(define channel-room (make-room 'channel)) (define channel-room (make-room 'channel))
@ -1026,12 +1023,15 @@
(standard-thread (lambda () (standard-thread (lambda ()
(run-channel oob-ch (run-channel oob-ch
app-a2s app-a2s
app-s2a
session-a2s session-a2s
session-s2a session-s2a
(join-room channel-room 'app) (join-room channel-room 'app))))
(standard-thread (lambda ()
(channel-main oob-ch app-s2a app-a2s))))))
(wait-for-members channel-room '(app)) (wait-for-members channel-room '(app))
(standard-thread (lambda ()
(channel-main oob-ch app-s2a app-a2s)))
channel-room) channel-room)
(define (simple-ssh-server handle channel-open-callback state) (define (simple-ssh-server handle channel-open-callback state)