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

* Implementer global sandbox memory limit and added

Browse Source 
`sandbox-memory-limit' to set it
* Added `evaluator-alive?'
* Undo accidental commenting of most tests

svn: r12786
This commit is contained in:
Eli Barzilay 2008-12-12 12:45:08 +00:00
parent a0d1baea00
commit a1222d66ca
3 changed files with 403 additions and 331 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/scheme/sandbox.ss
View File

@ -21,7 +21,9 @@
sandbox-network-guard sandbox-network-guard
sandbox-make-inspector sandbox-make-inspector
sandbox-make-logger sandbox-make-logger
sandbox-memory-limit
sandbox-eval-limits sandbox-eval-limits
evaluator-alive?
kill-evaluator kill-evaluator
break-evaluator break-evaluator
set-eval-limits set-eval-limits
@ -52,6 +54,7 @@
(define sandbox-output (make-parameter #f)) (define sandbox-output (make-parameter #f))
(define sandbox-error-output (define sandbox-error-output
(make-parameter (lambda () (dup-output-port (current-error-port))))) (make-parameter (lambda () (dup-output-port (current-error-port)))))
(define sandbox-memory-limit (make-parameter 20)) ; 30mb total
(define sandbox-eval-limits (make-parameter '(30 20))) ; 30sec, 20mb (define sandbox-eval-limits (make-parameter '(30 20))) ; 30sec, 20mb
(define sandbox-propagate-breaks (make-parameter #t)) (define sandbox-propagate-breaks (make-parameter #t))
(define sandbox-coverage-enabled (make-parameter #f)) (define sandbox-coverage-enabled (make-parameter #f))
@ -465,6 +468,7 @@
(let ([evmsg (make-evaluator-message msg '())]) (let ([evmsg (make-evaluator-message msg '())])
(lambda (evaluator) (evaluator evmsg))))])) (lambda (evaluator) (evaluator evmsg))))]))
(define-evaluator-messenger evaluator-alive? 'alive?)
(define-evaluator-messenger kill-evaluator 'kill) (define-evaluator-messenger kill-evaluator 'kill)
(define-evaluator-messenger break-evaluator 'break) (define-evaluator-messenger break-evaluator 'break)
(define-evaluator-messenger (set-eval-limits secs mb) 'limits) (define-evaluator-messenger (set-eval-limits secs mb) 'limits)
@ -477,6 +481,7 @@
(define (make-evaluator* init-hook allow program-maker) (define (make-evaluator* init-hook allow program-maker)
(define orig-cust (current-custodian)) (define orig-cust (current-custodian))
(define user-cust (make-custodian orig-cust)) (define user-cust (make-custodian orig-cust))
(define user-cust-box (make-custodian-box user-cust #t))
(define coverage? (sandbox-coverage-enabled)) (define coverage? (sandbox-coverage-enabled))
(define uncovered #f) (define uncovered #f)
(define input-ch (make-channel)) (define input-ch (make-channel))
@ -569,6 +574,9 @@
(if (evaluator-message? expr) (if (evaluator-message? expr)
(let ([msg (evaluator-message-msg expr)]) (let ([msg (evaluator-message-msg expr)])
(case msg (case msg
[(alive?) (and (custodian-box-value user-cust-box)
user-thread
(not (thread-dead? user-thread)))]
[(kill) (user-kill)] [(kill) (user-kill)]
[(break) (user-break)] [(break) (user-break)]
[(limits) (set! limits (evaluator-message-args expr))] [(limits) (set! limits (evaluator-message-args expr))]
@ -599,6 +607,10 @@
(if bytes? buf (bytes->string/utf-8 buf #\?))))) (if bytes? buf (bytes->string/utf-8 buf #\?)))))
out)] out)]
[else (error 'make-evaluator "bad sandox-~a spec: ~e" what out)])) [else (error 'make-evaluator "bad sandox-~a spec: ~e" what out)]))
;; set global memory limit
(when (sandbox-memory-limit)
(custodian-limit-memory
user-cust (* (sandbox-memory-limit) 1024 1024) user-cust))
(parameterize* ; the order in these matters (parameterize* ; the order in these matters
(;; create a sandbox context first (;; create a sandbox context first
[current-custodian user-cust] [current-custodian user-cust]

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

@ -176,8 +176,11 @@ environment:
@item{The evaluator works under the @scheme[sandbox-security-guard], @item{The evaluator works under the @scheme[sandbox-security-guard],
which restricts file system and network access.} which restricts file system and network access.}
@item{Each evaluation is wrapped in a @scheme[call-with-limits]; see @item{The evaluator is contained in a memory-restricted environment,
also @scheme[sandbox-eval-limits] and @scheme[set-eval-limits].} and each evaluation is wrapped in a @scheme[call-with-limits]
(when memory accounting is available); see also
@scheme[sandbox-memory-limit], @scheme[sandbox-eval-limits] and
@scheme[set-eval-limits].}
] ]
Note that these limits apply to the creation of the sandbox Note that these limits apply to the creation of the sandbox
environment too --- so, for example, if the memory that is required to environment too --- so, for example, if the memory that is required to
@ -466,6 +469,15 @@ default @scheme[sandbox-security-guard]. The default forbids all
network connection.} network connection.}
@defparam[sandbox-memory-limit limit (or/c exact-nonnegative-integer? #f)]{
A parameter that determines the total memory limit on the sandbox.
When this limit is exceeded, the sandbox is terminated. This value is
used when the sandbox is created and the limit cannot be changed
afterwards. See @scheme[sandbox-eval-limits] for per-evaluation
limits and a description of how the two limits work together.}
@defparam[sandbox-eval-limits limits @defparam[sandbox-eval-limits limits
(or/c (list/c (or/c exact-nonnegative-integer? #f) (or/c (list/c (or/c exact-nonnegative-integer? #f)
(or/c exact-nonnegative-integer? #f)) (or/c exact-nonnegative-integer? #f))
@ -473,12 +485,13 @@ network connection.}
A parameter that determines the default limits on @italic{each} use of A parameter that determines the default limits on @italic{each} use of
a @scheme[make-evaluator] function, including the initial evaluation a @scheme[make-evaluator] function, including the initial evaluation
of the input program. Its value should be a list of two numbers, the of the input program. Its value should be a list of two numbers;
first is a timeout value in seconds, and the second is a memory limit where the first is a timeout value in seconds, and the second is a
in megabytes. Either one can be @scheme[#f] for disabling the memory limit in megabytes. Either one can be @scheme[#f] for
corresponding limit; alternately, the parameter can be set to disabling the corresponding limit; alternately, the parameter can be
@scheme[#f] to disable all limits (useful in case more limit kinds are set to @scheme[#f] to disable all per-evaluation limits (useful in
available in future versions). The default is @scheme[(list 30 20)]. case more limit kinds are available in future versions). The default
is @scheme[(list 30 20)].
Note that these limits apply to the creation of the sandbox Note that these limits apply to the creation of the sandbox
environment too --- even @scheme[(make-evaluator 'scheme/base)] can environment too --- even @scheme[(make-evaluator 'scheme/base)] can
@ -488,7 +501,45 @@ you need to catch errors that happen when the sandbox is created.
When limits are set, @scheme[call-with-limits] (see below) is wrapped When limits are set, @scheme[call-with-limits] (see below) is wrapped
around each use of the evaluator, so consuming too much time or memory around each use of the evaluator, so consuming too much time or memory
results in an exception. Change the limits of a running evaluator results in an exception. Change the limits of a running evaluator
using @scheme[set-eval-limits].} using @scheme[set-eval-limits].
@margin-note{A custodian's limit is checked only after a garbage
collection, except that it may also be checked during
certain large allocations that are individually larger
than the custodian's limit.}
The memory limit that is specified by this parameter applies to each
individual evaluation, but not to the whole sandbox --- that limit is
specified via @scheme[sandbox-memory-limit]. When the global limit is
exceeded, the sandbox is terminated, but when the per-evaluation limit
is exceeded the @exnraise[exn:fail:resource]. For example, say that
you evaluate an expression like
@schemeblock[
(for ([i (in-range 1000)])
(set! a (cons (make-bytes 1000000) a))
(collect-garbage))
]
then, assuming sufficiently small limits,
@itemize[
@item{if a global limit is set but no per-evaluation limit, the
sandbox will eventually be terminated and no further
evaluations possible;}
@item{if there is a per-evaluation limit, but no global limit, the
evaluation will abort with an error and it can be used again
--- specifically, @scheme[a] will still hold a number of
blocks, and you can evaluate the same expression again which
will add more blocks to it;}
@item{if both limits are set, with the global one larger than the
per-evaluation limit, then the evaluation will abort and you
will be able to repeat it, but doing so several times will
eventually terminate the sandbox (this will be indicated by
the error message, and by the @scheme[evaluator-alive?]
predicate).}
]}
@defparam[sandbox-make-inspector make (-> inspector?)]{ @defparam[sandbox-make-inspector make (-> inspector?)]{
@ -510,6 +561,12 @@ evaluator, and the default parameter value is @scheme[current-logger].}
The following functions are used to interact with a sandboxed The following functions are used to interact with a sandboxed
evaluator in addition to using it to evaluate code. evaluator in addition to using it to evaluate code.
@defproc[(evaluator-alive? [evaluator (any/c . -> . any)]) boolean?]{
Determines whether the evaluator is still alive.}
@defproc[(kill-evaluator [evaluator (any/c . -> . any)]) void?]{ @defproc[(kill-evaluator [evaluator (any/c . -> . any)]) void?]{
Releases the resources that are held by @scheme[evaluator] by shutting Releases the resources that are held by @scheme[evaluator] by shutting

647
collects/tests/mzscheme/sandbox.ss
View File

@ -64,326 +64,328 @@
(t (t
;! ;; basic stuff, limits ;; basic stuff, limits
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base (set! ev (make-evaluator 'scheme/base
;! (make-prog "(define x 1)" (make-prog "(define x 1)"
;! "(define (id x) x)" "(define (id x) x)"
;! "(define (plus1 x) x)" "(define (plus1 x) x)"
;! "(define (loop) (loop))" "(define (loop) (loop))"
;! "(define (memory x) (make-vector x))"))) "(define (memory x) (make-vector x))")))
;! (set-eval-limits ev 1 3) (set-eval-limits ev 1 3)
;! --eval-- --eval--
;! x => 1 x => 1
;! (id 1) => 1 (id 1) => 1
;! (id (plus1 x)) => 1 (id (plus1 x)) => 1
;! (define id2 id) (define id2 id)
;! (id2 (id x)) => 1 (id2 (id x)) => 1
;! blah =err> "before its definition" blah =err> "before its definition"
;! ;; using a string for an input ;; using a string for an input
;! "1" => 1 "1" => 1
;! "(+ 1 2) x (define y 9) y (set! y 99) y" => 99 "(+ 1 2) x (define y 9) y (set! y 99) y" => 99
;! "bad\"string" =err> "expected a closing" "bad\"string" =err> "expected a closing"
;! "bad(string" =err> "expected a .\\)." "bad(string" =err> "expected a .\\)."
;! "bad)string" =err> "unexpected .\\)." "bad)string" =err> "unexpected .\\)."
;! "(set! y 999) (string" =err> "expected a .\\)." "(set! y 999) (string" =err> "expected a .\\)."
;! y => 99 y => 99
;! "(set! y 999) (if)" =err> "if: bad syntax" "(set! y 999) (if)" =err> "if: bad syntax"
;! y => 999 y => 999
;! ;; test limits ;; test limits
;! (loop) =err> "out of time" (loop) =err> "out of time"
;! --top-- --top--
;! (when (custodian-memory-accounting-available?) (when (custodian-memory-accounting-available?)
;! (t --eval-- (memory 1000000) =err> "out of memory")) (t --eval-- (memory 1000000) =err> "out of memory"))
;! ;; test parameter settings (tricky to get this right since ;; test parameter settings (tricky to get this right since
;! ;; with-limits runs stuff in a different thread) ;; with-limits runs stuff in a different thread)
;! (set-eval-limits ev #f #f) (set-eval-limits ev #f #f)
;! --eval-- --eval--
;! (define p (make-parameter 0)) (define p (make-parameter 0))
;! (p) => 0 (p) => 0
;! (p 1) (p 1)
;! (p) => 1 (p) => 1
;! (thread-wait (thread (lambda () (p 100)))) (thread-wait (thread (lambda () (p 100))))
;! (p) => 1 (p) => 1
;! --top-- --top--
;! (set-eval-limits ev 1 3) (set-eval-limits ev 1 3)
;! --eval-- --eval--
;! (p) => 1 (p) => 1
;! (p 2) (p 2)
;! (p) => 2 (p) => 2
;! (thread-wait (thread (lambda () (p 100)))) (thread-wait (thread (lambda () (p 100))))
;! (p) => 2 (p) => 2
;! --top-- --top--
;! (set-eval-limits ev #f #f) (set-eval-limits ev #f #f)
;! --eval-- --eval--
;! (p) => 2 (p) => 2
;! ;; breaking ;; breaking
;! --top-- --top--
;! (thread (lambda () (sleep 1) (break-evaluator ev))) (thread (lambda () (sleep 1) (break-evaluator ev)))
;! --eval-- --eval--
;! (sleep 2) =err> "user break" (sleep 2) =err> "user break"
;! ;; termination ;; termination
;! --eval-- --eval--
;! (printf "x = ~s\n" x) => (void) (printf "x = ~s\n" x) => (void)
;! ,eof =err> "terminated" ,eof =err> "terminated"
;! x =err> "terminated" x =err> "terminated"
;! ,eof =err> "terminated" ,eof =err> "terminated"
;!
;! ;; i/o ;; i/o
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-input "3\n"] (set! ev (parameterize ([sandbox-input "3\n"]
;! [sandbox-output 'string] [sandbox-output 'string]
;! [sandbox-error-output current-output-port]) [sandbox-error-output current-output-port])
;! (make-evaluator 'scheme/base '(define x 123)))) (make-evaluator 'scheme/base '(define x 123))))
;! --eval-- (printf "x = ~s\n" x) => (void) --eval-- (printf "x = ~s\n" x) => (void)
;! --top-- (get-output ev) => "x = 123\n" --top-- (get-output ev) => "x = 123\n"
;! --eval-- (printf "x = ~s\n" x) => (void) --eval-- (printf "x = ~s\n" x) => (void)
;! --top-- (get-output ev) => "x = 123\n" --top-- (get-output ev) => "x = 123\n"
;! --eval-- (printf "x*2 = ~s\n" (+ x x)) => (void) --eval-- (printf "x*2 = ~s\n" (+ x x)) => (void)
;! (printf "x*10 = ~s\n" (* 10 x)) => (void) (printf "x*10 = ~s\n" (* 10 x)) => (void)
;! --top-- (get-output ev) => "x*2 = 246\nx*10 = 1230\n" --top-- (get-output ev) => "x*2 = 246\nx*10 = 1230\n"
;! --eval-- (printf "x*(read) = ~s\n" (* x (read))) => (void) --eval-- (printf "x*(read) = ~s\n" (* x (read))) => (void)
;! --top-- (get-output ev) => "x*(read) = 369\n" --top-- (get-output ev) => "x*(read) = 369\n"
;! --eval-- (begin (printf "a\n") (fprintf (current-error-port) "b\n")) --eval-- (begin (printf "a\n") (fprintf (current-error-port) "b\n"))
;! --top-- (get-output ev) => "a\nb\n" --top-- (get-output ev) => "a\nb\n"
;! (get-error-output ev) => #f (get-error-output ev) => #f
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-output 'string] (set! ev (parameterize ([sandbox-output 'string]
;! [sandbox-error-output 'string]) [sandbox-error-output 'string])
;! (make-evaluator 'scheme/base))) (make-evaluator 'scheme/base)))
;! --eval-- (begin (printf "a\n") (fprintf (current-error-port) "b\n")) --eval-- (begin (printf "a\n") (fprintf (current-error-port) "b\n"))
;! --top-- (get-output ev) => "a\n" --top-- (get-output ev) => "a\n"
;! (get-error-output ev) => "b\n" (get-error-output ev) => "b\n"
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-input 'pipe] (set! ev (parameterize ([sandbox-input 'pipe]
;! [sandbox-output 'bytes] [sandbox-output 'bytes]
;! [sandbox-error-output current-output-port] [sandbox-error-output current-output-port]
;! [sandbox-eval-limits '(0.25 10)]) [sandbox-eval-limits '(0.25 10)])
;! (make-evaluator 'scheme/base '(define x 123)))) (make-evaluator 'scheme/base '(define x 123))))
;! --eval-- (begin (printf "x = ~s\n" x) --eval-- (begin (printf "x = ~s\n" x)
;! (fprintf (current-error-port) "err\n")) (fprintf (current-error-port) "err\n"))
;! --top-- (get-output ev) => #"x = 123\nerr\n" --top-- (get-output ev) => #"x = 123\nerr\n"
;! (put-input ev "blah\n") (put-input ev "blah\n")
;! (put-input ev "blah\n") (put-input ev "blah\n")
;! --eval-- (read-line) => "blah" --eval-- (read-line) => "blah"
;! (printf "line = ~s\n" (read-line)) (printf "line = ~s\n" (read-line))
;! --top-- (get-output ev) => #"line = \"blah\"\n" --top-- (get-output ev) => #"line = \"blah\"\n"
;! --eval-- (read-line) =err> "out of time" --eval-- (read-line) =err> "out of time"
;! --top-- (put-input ev "blah\n") --top-- (put-input ev "blah\n")
;! (put-input ev eof) (put-input ev eof)
;! --eval-- (read-line) => "blah" --eval-- (read-line) => "blah"
;! (read-line) => eof (read-line) => eof
;! (read-line) => eof (read-line) => eof
;! ;; test kill-evaluator here ;; test kill-evaluator here
;! --top-- --top--
;! (kill-evaluator ev) => (void) (kill-evaluator ev) => (void)
;! --eval-- --eval--
;! x =err> "terminated" x =err> "terminated"
;! y =err> "terminated" y =err> "terminated"
;! ,eof =err> "terminated" ,eof =err> "terminated"
;! --top-- --top--
;! (let-values ([(i1 o1) (make-pipe)] [(i2 o2) (make-pipe)]) (let-values ([(i1 o1) (make-pipe)] [(i2 o2) (make-pipe)])
;! ;; o1 -> i1 -ev-> o2 -> i2 ;; o1 -> i1 -ev-> o2 -> i2
;! (set! ev (parameterize ([sandbox-input i1] [sandbox-output o2]) (set! ev (parameterize ([sandbox-input i1] [sandbox-output o2])
;! (make-evaluator 'scheme/base '(define x 123)))) (make-evaluator 'scheme/base '(define x 123))))
;! (t --eval-- (printf "x = ~s\n" x) => (void) (t --eval-- (printf "x = ~s\n" x) => (void)
;! --top-- (read-line i2) => "x = 123" --top-- (read-line i2) => "x = 123"
;! --eval-- (printf "x = ~s\n" x) => (void) --eval-- (printf "x = ~s\n" x) => (void)
;! --top-- (read-line i2) => "x = 123" --top-- (read-line i2) => "x = 123"
;! --eval-- (printf "x*2 = ~s\n" (+ x x)) => (void) --eval-- (printf "x*2 = ~s\n" (+ x x)) => (void)
;! (printf "x*10 = ~s\n" (* 10 x)) => (void) (printf "x*10 = ~s\n" (* 10 x)) => (void)
;! --top-- (read-line i2) => "x*2 = 246" --top-- (read-line i2) => "x*2 = 246"
;! (read-line i2) => "x*10 = 1230" (read-line i2) => "x*10 = 1230"
;! (fprintf o1 "3\n") (fprintf o1 "3\n")
;! --eval-- (printf "x*(read) = ~s\n" (* x (read))) => (void) --eval-- (printf "x*(read) = ~s\n" (* x (read))) => (void)
;! --top-- (read-line i2) => "x*(read) = 369" --top-- (read-line i2) => "x*(read) = 369"
;! )) ))
;!
;! ;; sexprs as a program ;; sexprs as a program
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base '(define id (lambda (x) x)))) (set! ev (make-evaluator 'scheme/base '(define id (lambda (x) x))))
;! --eval-- --eval--
;! (id 123) => 123 (id 123) => 123
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base '(define id (lambda (x) x)) (set! ev (make-evaluator 'scheme/base '(define id (lambda (x) x))
;! '(define fooo 999))) '(define fooo 999)))
;! --eval-- --eval--
;! (id fooo) => 999 (id fooo) => 999
;!
;! ;; test source locations too ;; test source locations too
;! --top-- --top--
;! (make-evaluator 'scheme/base 0 1 2 '(define foo)) (make-evaluator 'scheme/base 0 1 2 '(define foo))
;! =err> "program:4:0: define" =err> "program:4:0: define"
;!
;! ;; empty program for clean repls ;; empty program for clean repls
;! --top-- --top--
;! (set! ev (make-evaluator '(begin))) (set! ev (make-evaluator '(begin)))
;! --eval-- --eval--
;! (define x (+ 1 2 3)) => (void) (define x (+ 1 2 3)) => (void)
;! x => 6 x => 6
;! (define x (+ x 10)) => (void) (define x (+ x 10)) => (void)
;! x => 16 x => 16
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base)) (set! ev (make-evaluator 'scheme/base))
;! --eval-- --eval--
;! (define x (+ 1 2 3)) => (void) (define x (+ 1 2 3)) => (void)
;! x => 6 x => 6
;! (define x (+ x 10)) => (void) (define x (+ x 10)) => (void)
;! x => 16 x => 16
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base '(define x (+ 1 2 3)))) (set! ev (make-evaluator 'scheme/base '(define x (+ 1 2 3))))
;! --eval-- --eval--
;! (define x (+ x 10)) =err> "cannot re-define a constant" (define x (+ x 10)) =err> "cannot re-define a constant"
;!
;! ;; whole program argument ;; whole program argument
;! --top-- --top--
;! (set! ev (make-module-evaluator '(module foo scheme/base (define x 1)))) (set! ev (make-module-evaluator '(module foo scheme/base (define x 1))))
;! --eval-- --eval--
;! x => 1 x => 1
;! --top-- --top--
;! (set! ev (make-module-evaluator (set! ev (make-module-evaluator
;! '(module foo scheme/base (provide x) (define x 1)))) '(module foo scheme/base (provide x) (define x 1))))
;! --eval-- --eval--
;! x => 1 x => 1
;! (define x 2) =err> "cannot re-define a constant" (define x 2) =err> "cannot re-define a constant"
;!
;! ;; limited FS access, allowed for requires ;; limited FS access, allowed for requires
;! --top-- --top--
;! (let* ([tmp (find-system-path 'temp-dir)] (let* ([tmp (find-system-path 'temp-dir)]
;! [schemelib (path->string (collection-path "scheme"))] [schemelib (path->string (collection-path "scheme"))]
;! [list-lib (path->string (build-path schemelib "list.ss"))] [list-lib (path->string (build-path schemelib "list.ss"))]
;! [test-lib (path->string (build-path tmp "sandbox-test.ss"))]) [test-lib (path->string (build-path tmp "sandbox-test.ss"))])
;! (t --top-- (t --top--
;! (set! ev (make-evaluator 'scheme/base)) (set! ev (make-evaluator 'scheme/base))
;! --eval-- --eval--
;! ;; reading from collects is allowed ;; reading from collects is allowed
;! (list (directory-list ,schemelib)) (list (directory-list ,schemelib))
;! (file-exists? ,list-lib) => #t (file-exists? ,list-lib) => #t
;! (input-port? (open-input-file ,list-lib)) => #t (input-port? (open-input-file ,list-lib)) => #t
;! ;; writing is forbidden ;; writing is forbidden
;! (open-output-file ,list-lib) =err> "`write' access denied" (open-output-file ,list-lib) =err> "`write' access denied"
;! ;; reading from other places is forbidden ;; reading from other places is forbidden
;! (directory-list ,tmp) =err> "`read' access denied" (directory-list ,tmp) =err> "`read' access denied"
;! ;; no network too ;; no network too
;! (require scheme/tcp) (require scheme/tcp)
;! (tcp-listen 12345) =err> "network access denied" (tcp-listen 12345) =err> "network access denied"
;! --top-- --top--
;! ;; reading from a specified require is fine ;; reading from a specified require is fine
;! (with-output-to-file test-lib (with-output-to-file test-lib
;! (lambda () (lambda ()
;! (printf "~s\n" '(module sandbox-test scheme/base (printf "~s\n" '(module sandbox-test scheme/base
;! (define x 123) (provide x)))) (define x 123) (provide x))))
;! #:exists 'replace) #:exists 'replace)
;! (set! ev (make-evaluator 'scheme/base #:requires `(,test-lib))) (set! ev (make-evaluator 'scheme/base #:requires `(,test-lib)))
;! --eval-- --eval--
;! x => 123 x => 123
;! (length (with-input-from-file ,test-lib read)) => 5 (length (with-input-from-file ,test-lib read)) => 5
;! ;; the directory is still not kosher ;; the directory is still not kosher
;! (directory-list ,tmp) =err> "`read' access denied" (directory-list ,tmp) =err> "`read' access denied"
;! --top-- --top--
;! ;; should work also for module evaluators ;; should work also for module evaluators
;! ;; --> NO! Shouldn't make user code require whatever it wants ;; --> NO! Shouldn't make user code require whatever it wants
;! ;; (set! ev (make-evaluator `(module foo scheme/base ;; (set! ev (make-evaluator `(module foo scheme/base
;! ;; (require (file ,test-lib))))) ;; (require (file ,test-lib)))))
;! ;; --eval-- ;; --eval--
;! ;; x => 123 ;; x => 123
;! ;; (length (with-input-from-file ,test-lib read)) => 5 ;; (length (with-input-from-file ,test-lib read)) => 5
;! ;; ;; the directory is still not kosher ;; ;; the directory is still not kosher
;! ;; (directory-list tmp) =err> "file access denied" ;; (directory-list tmp) =err> "file access denied"
;! --top-- --top--
;! ;; explicitly allow access to tmp ;; explicitly allow access to tmp
;! (set! ev (parameterize ([sandbox-path-permissions (set! ev (parameterize ([sandbox-path-permissions
;! `((read ,tmp) `((read ,tmp)
;! ,@(sandbox-path-permissions))]) ,@(sandbox-path-permissions))])
;! (make-evaluator 'scheme/base))) (make-evaluator 'scheme/base)))
;! --eval-- --eval--
;! (length (with-input-from-file ,test-lib read)) => 5 (length (with-input-from-file ,test-lib read)) => 5
;! (list? (directory-list ,tmp)) (list? (directory-list ,tmp))
;! (open-output-file ,(build-path tmp "blah")) =err> "access denied" (open-output-file ,(build-path tmp "blah")) =err> "access denied"
;! (delete-directory ,(build-path tmp "blah")) =err> "access denied") (delete-directory ,(build-path tmp "blah")) =err> "access denied")
;! (delete-file test-lib)) (delete-file test-lib))
;!
;! ;; languages and requires ;; languages and requires
;! --top-- --top--
;! (set! ev (make-evaluator '(special r5rs) "(define x (eq? 'x 'X))")) (set! ev (make-evaluator '(special r5rs) "(define x (eq? 'x 'X))"))
;! --eval-- --eval--
;! x => #t x => #t
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base "(define l null)")) (set! ev (make-evaluator 'scheme/base "(define l null)"))
;! --eval-- --eval--
;! (cond [null? l 0]) => 0 (cond [null? l 0]) => 0
;! (last-pair l) =err> "reference to an identifier" (last-pair l) =err> "reference to an identifier"
;! --top-- --top--
;! (set! ev (make-evaluator '(special beginner) (set! ev (make-evaluator '(special beginner)
;! (make-prog "(define l null)" "(define x 3.5)"))) (make-prog "(define l null)" "(define x 3.5)")))
;! --eval-- --eval--
;! (cond [null? l 0]) =err> "expected an open parenthesis" (cond [null? l 0]) =err> "expected an open parenthesis"
;! --top-- --top--
;! (eq? (ev "6") (ev "(sub1 (* 2 3.5))")) (eq? (ev "6") (ev "(sub1 (* 2 3.5))"))
;! (eq? (ev "6") (ev "(sub1 (* 2 x))")) (eq? (ev "6") (ev "(sub1 (* 2 x))"))
;! --top-- --top--
;! (set! ev (make-evaluator 'scheme/base #:requires '(scheme/list))) (set! ev (make-evaluator 'scheme/base #:requires '(scheme/list)))
;! --eval-- --eval--
;! (last-pair '(1 2 3)) => '(3) (last-pair '(1 2 3)) => '(3)
;! (last-pair null) =err> "expected argument of type" (last-pair null) =err> "expected argument of type"
;!
;! ;; coverage ;; coverage
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-coverage-enabled #t]) (set! ev (parameterize ([sandbox-coverage-enabled #t])
;! (make-evaluator 'scheme/base (make-evaluator 'scheme/base
;! (make-prog "(define (foo x) (+ x 1))" (make-prog "(define (foo x) (+ x 1))"
;! "(define (bar x) (+ x 2))" "(define (bar x) (+ x 2))"
;! "(equal? (foo 3) 4)")))) "(equal? (foo 3) 4)"))))
;! (pair? (get-uncovered-expressions ev)) (pair? (get-uncovered-expressions ev))
;! (pair? (get-uncovered-expressions ev #t)) (pair? (get-uncovered-expressions ev #t))
;! --eval-- --eval--
;! (foo 3) => 4 (foo 3) => 4
;! (bar 10) => 12 (bar 10) => 12
;! --top-- --top--
;! (null? (get-uncovered-expressions ev #f)) (null? (get-uncovered-expressions ev #f))
;! (pair? (get-uncovered-expressions ev)) ; no-tests coverage still the same (pair? (get-uncovered-expressions ev)) ; no-tests coverage still the same
;!
;! ;; misc parameters ;; misc parameters
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-init-hook (set! ev (parameterize ([sandbox-init-hook
;! (let ([old (sandbox-init-hook)]) (let ([old (sandbox-init-hook)])
;! (lambda () (lambda ()
;! (old) (old)
;! (compile-enforce-module-constants #f) (compile-enforce-module-constants #f)
;! (compile-allow-set!-undefined #t)))]) (compile-allow-set!-undefined #t)))])
;! (make-evaluator 'scheme/base '(define x 123)))) (make-evaluator 'scheme/base '(define x 123))))
;! --eval-- --eval--
;! (set! x 456) ; would be an error without the `enforce' parameter (set! x 456) ; would be an error without the `enforce' parameter
;! x => 456 x => 456
;! (set! y 789) ; would be an error without the `set!' parameter (set! y 789) ; would be an error without the `set!' parameter
;! y => 789 y => 789
;!
;! ;; test that output is also collected under the limit ;; test that output is also collected under the limit
;! --top-- --top--
;! (set! ev (parameterize ([sandbox-output 'bytes] (set! ev (parameterize ([sandbox-output 'bytes]
;! [sandbox-error-output current-output-port] [sandbox-error-output current-output-port]
;! [sandbox-eval-limits '(0.25 1/2)]) [sandbox-memory-limit 5]
;! (make-evaluator 'scheme/base))) [sandbox-eval-limits '(0.25 1/2)])
;! ;; GCing is needed to allow these to happen (make-evaluator 'scheme/base)))
;! --eval-- (display (make-bytes 400000 65)) ;; GCing is needed to allow these to happen
;! --top-- (bytes-length (get-output ev)) => 400000 --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! --eval-- (display (make-bytes 400000 65)) --top-- (bytes-length (get-output ev)) => 400000
;! --top-- (bytes-length (get-output ev)) => 400000 --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! --eval-- (display (make-bytes 400000 65)) --top-- (bytes-length (get-output ev)) => 400000
;! --top-- (bytes-length (get-output ev)) => 400000 --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! --eval-- (display (make-bytes 400000 65)) --top-- (bytes-length (get-output ev)) => 400000
;! --top-- (bytes-length (get-output ev)) => 400000 --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! --eval-- (display (make-bytes 400000 65)) --top-- (bytes-length (get-output ev)) => 400000
;! --top-- (bytes-length (get-output ev)) => 400000 --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! ;; EB: for some reason, the first thing doesn't throw an error, and I think --top-- (bytes-length (get-output ev)) => 400000
;! ;; that the second should break much sooner than 100 iterations --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! ;; --eval-- (let ([400k (make-bytes 400000 65)]) --top-- (bytes-length (get-output ev)) => 400000
;! ;; (for ([i (in-range 2)]) (display 400k))) --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! ;; --top-- (bytes-length (get-output ev)) --top-- (bytes-length (get-output ev)) => 400000
;! ;; =err> "out of memory" --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! ;; --eval-- (let ([400k (make-bytes 400000 65)]) --top-- (bytes-length (get-output ev)) => 400000
;! ;; (for ([i (in-range 100)]) (display 400k))) --eval-- (display (make-bytes 400000 65)) (collect-garbage)
;! ;; =err> "out of memory" --top-- (bytes-length (get-output ev)) => 400000
--eval-- (display (make-bytes 400000 65)) (collect-garbage)
--top-- (bytes-length (get-output ev)) => 400000
;; test that killing the custodian works fine ;; test that killing the custodian works fine
;; first try it without limits (limits imply a nested thread/custodian) ;; first try it without limits (limits imply a nested thread/custodian)
@ -428,13 +430,14 @@
;; when an expression is out of memory, the sandbox should stay alive ;; when an expression is out of memory, the sandbox should stay alive
--top-- --top--
(set! ev (parameterize ([sandbox-eval-limits '(2 5)]) (set! ev (parameterize ([sandbox-eval-limits '(2 5)]
[sandbox-memory-limit 100])
(make-evaluator 'scheme/base))) (make-evaluator 'scheme/base)))
--eval-- --eval--
(define a '()) (define a '())
(define b 1) (define b 1)
(for ([i (in-range 20)]) (for ([i (in-range 20)])
(set! a (cons (make-bytes 1000000) a)) (set! a (cons (make-bytes 500000) a))
(collect-garbage)) (collect-garbage))
=err> "out of memory" =err> "out of memory"
b => 1 b => 1