From 86532648686df90bca47e7193da7d7d6a681ec5b Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 19 Feb 2008 15:20:37 +0000 Subject: [PATCH] cleaned up the interface a little svn: r8724 --- collects/scheme/sandbox.ss | 54 ++++++++++++-------- collects/scribblings/reference/sandbox.scrbl | 48 ++++++++++------- 2 files changed, 63 insertions(+), 39 deletions(-) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index 4a54897559..ef4cfae374 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -400,14 +400,24 @@ values)) (define null-input (open-input-bytes #"")) -(define (kill-evaluator eval) (eval kill-evaluator)) -(define (break-evaluator eval) (eval break-evaluator)) -(define (set-eval-limits eval . args) ((eval set-eval-limits) args)) -(define (put-input eval . args) (apply (eval put-input) args)) -(define (get-output eval) (eval get-output)) -(define (get-error-output eval) (eval get-error-output)) -(define (get-uncovered-expressions eval . args) - (apply (eval get-uncovered-expressions) args)) +(define-struct evaluator-message (msg args)) +(define-syntax define-evaluator-messenger + (syntax-rules () + [(define-evaluator-messenger name msg) + (define name + (let ([evmsg (make-evaluator-message msg #f)]) + (lambda (evaluator) (evaluator evmsg))))] + [(define-evaluator-messenger name msg (... ...)) ; with extra args + (define (name evaluator . args) + (evaluator (make-evaluator-message msg args)))])) + +(define-evaluator-messenger kill-evaluator 'kill) +(define-evaluator-messenger break-evaluator 'break) +(define-evaluator-messenger set-eval-limits 'limits ...) +(define-evaluator-messenger put-input 'input ...) +(define-evaluator-messenger get-output 'output) +(define-evaluator-messenger get-error-output 'error-output) +(define-evaluator-messenger get-uncovered-expressions 'uncovered ...) (define (make-evaluator* init-hook require-perms program-or-maker) (define cust (make-custodian)) @@ -485,23 +495,26 @@ (define (output-getter p) (if (procedure? p) (user-eval `(,p)) p)) (define input-putter (case-lambda - [() (input-putter input-putter)] + [() (input-putter input)] [(arg) (cond [(not input) (error 'put-input "evaluator input is not 'pipe")] [(or (string? arg) (bytes? arg)) (display arg input) (flush-output input)] [(eof-object? arg) (close-output-port input)] - [(eq? arg input-putter) input] - [else (error 'put-input "bad input: ~e" arg)])])) + [else (error 'put-input "bad argument: ~e" arg)])])) (define (evaluator expr) - (cond [(eq? expr kill-evaluator) (user-kill)] - [(eq? expr break-evaluator) (user-break)] - [(eq? expr set-eval-limits) (lambda (args) (set! limits args))] - [(eq? expr put-input) input-putter] - [(eq? expr get-output) (output-getter output)] - [(eq? expr get-error-output) (output-getter error-output)] - [(eq? expr get-uncovered-expressions) get-uncovered] - [else (user-eval expr)])) + (if (evaluator-message? expr) + (let ([msg (evaluator-message-msg expr)]) + (case msg + [(kill) (user-kill)] + [(break) (user-break)] + [(limits) (set! limits (evaluator-message-args expr))] + [(input) (apply input-putter (evaluator-message-args expr))] + [(output) (output-getter output)] + [(error-output) (output-getter error-output)] + [(uncovered) (apply get-uncovered (evaluator-message-args expr))] + [else (error 'evaluator "internal error, bad message: ~e" msg)])) + (user-eval expr))) (define linked-outputs? #f) (define (make-output what out set-out! allow-link?) (cond [(not out) (open-output-nowhere)] @@ -556,7 +569,8 @@ [current-security-guard (sandbox-security-guard)] [exit-handler (lambda x (error 'exit "user code cannot exit"))] [current-inspector ((sandbox-make-inspector))] - ;; This breaks: [current-code-inspector (make-inspector)] + ;; This breaks because we need to load some libraries that are trusted + ;; [current-code-inspector (make-inspector)] ;; Note the above definition of `current-eventspace': in MzScheme, it ;; is an unused parameter. Also note that creating an eventspace ;; starts a thread that will eventually run the callback code (which diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl index 51a7d3a4df..b4f2fa2d39 100644 --- a/collects/scribblings/reference/sandbox.scrbl +++ b/collects/scribblings/reference/sandbox.scrbl @@ -107,7 +107,7 @@ argument: set to customize reading programs from strings and ports. This option is provided mainly for older test systems. Using - @scheme[make-module-evaluator] with input starting + @scheme[make-module-evaluator] with input starting with @schememodfont{#lang} is generally better.} @item{Finally, @scheme[language] can be a list whose first element is @@ -156,7 +156,7 @@ module, and all imports are part of the program: @schemeblock[ (define base-module-eval2 (code:comment #, @t{equivalent to @scheme[base-module-eval]:}) - (make-module-evaluator '(module m scheme/base + (make-module-evaluator '(module m scheme/base (define (f) later) (define later 5)))) ] @@ -176,10 +176,25 @@ environment: also @scheme[sandbox-eval-limits] and @scheme[set-eval-limits].} } -Evaluation can also be instrumented to track evaluation information -when @scheme[sandbox-coverage-enabled] is set. Exceptions (both syntax -and run-time) are propagated as usual to the caller of the evaluation -function (i.e., catch it with @scheme[with-handlers]).} +Evaluation can also be instrumented to track coverage information when +@scheme[sandbox-coverage-enabled] is set. Exceptions (both syntax and +run-time) are propagated as usual to the caller of the evaluation +function (i.e., catch it with @scheme[with-handlers]). However, note +that a sandboxed evaluator is convenient for testing, since all +exceptions happen in the same way, so you don't need special code to +catch syntax errors. + +Finally, the fact that a sandboxed evaluator accept syntax objects +makes it usable as the value for @scheme{current-eval}, which means +that you can easily start a sandboxed read-eval-print-loop: + +@schemeblock[ +(define e + (make-module-evaluator '(module m scheme/base (define x 1)))) +(parameterize ([current-eval e]) (read-eval-print-loop)) +] + +} @; ---------------------------------------------------------------------- @@ -336,7 +351,7 @@ of code can be helpful: `(,(car specs) ,@(cdr specs) lang/posn - ,@(if mred? '(mrlib/cache-image-snip) '())))) + ,@(if gui? '(mrlib/cache-image-snip) '())))) ]} @@ -360,7 +375,7 @@ default forbids all filesystem I/O except for things in @scheme[sandbox-network-guard] for network connections.} -@defparam[sandbox-path-permissions perms +@defparam[sandbox-path-permissions perms (listof (list/c (one-of/c 'execute 'write 'delete 'read 'exists) (or/c byte-regexp? bytes? string? path?)))]{ @@ -401,12 +416,10 @@ default @scheme[sandbox-security-guard]. The default forbids all network connection.} -@defparam[sandbox-eval-limits limits (or/c - (list/c (or/c exact-nonnegative-integer? - false/c) - (or/c exact-nonnegative-integer? - false/c)) - false/c)]{ +@defparam[sandbox-eval-limits limits + (or/c (list/c (or/c exact-nonnegative-integer? false/c) + (or/c exact-nonnegative-integer? false/c)) + false/c)]{ A parameter that determines the default limits on @italic{each} use of a @scheme[make-evaluator] function, including the initial evaluation @@ -433,11 +446,8 @@ evaluator, and the default parameter value is @scheme[make-inspector].} @section{Interacting with Evaluators} -The following functions actually pass themselves to the given -procedure, and an evaluator procedure recognizes these procedures -(using @scheme[eq?]) to take an appropriate action---but you should -avoid relying on that fact. - +The following functions are used to interact with a sandboxed +evaluator in addition to using it to evaluate code. @defproc[(kill-evaluator [evaluator (any/c . -> . any)]) void?]{