Fix I/O and sharing of environments
This commit is contained in:
parent
11f7435b1c
commit
6f4efca1d2
|
@ -22,10 +22,12 @@
|
|||
(printf "Got API ~v\n" api)
|
||||
(semaphore-wait (make-semaphore 0)))))
|
||||
|
||||
(define *shells* (make-hash))
|
||||
(define *environments* (make-hash))
|
||||
|
||||
(define *interaction* (make-room 'interaction))
|
||||
|
||||
(define *interaction-handle* (make-parameter #f))
|
||||
|
||||
(define *prompt* "RacketSSH> ")
|
||||
|
||||
(define (->string/safe bs)
|
||||
|
@ -72,25 +74,28 @@
|
|||
(read-syntax "<ssh-session>" (current-input-port)))))
|
||||
(thunk)))
|
||||
|
||||
(define (get-user-evaluator username)
|
||||
(when (not (hash-has-key? *shells* username))
|
||||
(hash-set! *shells* username (make-evaluator 'racket/base)))
|
||||
(hash-ref *shells* username))
|
||||
(define (get-user-environment username)
|
||||
(when (not (hash-has-key? *environments* username))
|
||||
(hash-set! *environments* username (make-base-namespace)))
|
||||
(hash-ref *environments* username))
|
||||
|
||||
(define (repl-shell username in out)
|
||||
(fprintf out "Hello, ~a.\n" username)
|
||||
(define handle (join-room *interaction* username))
|
||||
(define env (get-user-environment 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 (get-user-evaluator username)))
|
||||
(current-namespace env)
|
||||
(sandbox-namespace-specs (list (lambda () env))))
|
||||
(parameterize ((current-eval (make-evaluator '(begin))))
|
||||
(printf "Hello, ~a.\n" username)
|
||||
(eval `(,*interaction-handle* ,handle))
|
||||
(eval `(define say ,(lambda (utterance)
|
||||
(printf " You: ~a\n" (->string/safe utterance))
|
||||
(send handle say utterance)
|
||||
(printf " You: ~a\n" (->string/safe utterance))
|
||||
(send (*interaction-handle*) say utterance)
|
||||
(void))))
|
||||
(call-with-interaction-prompt-read handle read-eval-print-loop))
|
||||
(fprintf out "\nGoodbye!\n")
|
||||
|
|
Loading…
Reference in New Issue