#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2012-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

;;; Sandbox management and use.

(require racket/match)
(require racket/sandbox)
(require (only-in racket/exn exn->string))

(provide repl-shell)

(struct user-state (name primary-sandbox primary-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 [err out])
  (match-define (user-state _ primary-sandbox primary-namespace) (get-user-state username))
  (parameterize ((current-input-port in)
		 (current-output-port out)
		 (current-error-port err)
		 (sandbox-input in)
		 (sandbox-output out)
		 (sandbox-error-output err)
		 (sandbox-memory-limit 2) ;; megabytes
		 (sandbox-eval-limits #f)
		 (sandbox-namespace-specs (list (lambda () primary-namespace))))
    (printf "Hello, ~a.\n" username)
    (define secondary-sandbox (make-evaluator '(begin)))
    ;; ^^ uses primary-namespace via sandbox-namespace-specs
    (parameterize ((current-namespace primary-namespace)
		   (current-eval secondary-sandbox))
      (let restart ()
        (with-handlers ([exn?
                         (lambda (e)
                           (fprintf err "~a" (exn->string e))
                           (flush-output err)
                           (restart))])
          (read-eval-print-loop))))
    (fprintf out "\nGoodbye!\n")
    (kill-evaluator secondary-sandbox)
    (close-input-port in)
    (close-output-port out)
    (close-output-port err)))