suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cleaned up the interface a little

Browse Source 
svn: r8724
This commit is contained in:
Eli Barzilay 2008-02-19 15:20:37 +00:00
parent 87dd133746
commit 8653264868
2 changed files with 63 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/scheme/sandbox.ss
View File

@ -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

48
collects/scribblings/reference/sandbox.scrbl
View File

@ -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?]{