#lang racket/base ;; Sandbox management and use. ;; ;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones ;;; ;;; This file is part of marketplace-ssh. ;;; ;;; marketplace-ssh is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as ;;; published by the Free Software Foundation, either version 3 of the ;;; License, or (at your option) any later version. ;;; ;;; marketplace-ssh is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with marketplace-ssh. If not, see ;;; . (require racket/match) (require racket/sandbox) (provide repl-shell) (struct user-state (name master-sandbox master-namespace) #:transparent) (define *user-states* (make-hash)) (define (get-user-state username) (when (not (hash-has-key? *user-states* username)) (let* ((sb (make-evaluator 'racket/base)) (ns (call-in-sandbox-context sb current-namespace))) (hash-set! *user-states* username (user-state username sb ns)))) (hash-ref *user-states* username)) (define (repl-shell username in out) (match-define (user-state _ master-sandbox master-namespace) (get-user-state username)) (parameterize ((current-input-port in) (current-output-port out) (current-error-port out) (sandbox-input in) (sandbox-output out) (sandbox-error-output out) (sandbox-memory-limit 2) ;; megabytes (sandbox-eval-limits #f) (sandbox-namespace-specs (list (lambda () master-namespace)))) (printf "Hello, ~a.\n" username) (define slave-sandbox (make-evaluator '(begin))) ;; ^^ uses master-namespace via sandbox-namespace-specs (parameterize ((current-namespace master-namespace) (current-eval slave-sandbox)) (read-eval-print-loop)) (fprintf out "\nGoodbye!\n") (kill-evaluator slave-sandbox) (close-input-port in) (close-output-port out)))