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-make-inspector
sandbox-make-logger
sandbox-memory-limit
sandbox-eval-limits
evaluator-alive?
kill-evaluator
break-evaluator
set-eval-limits
@ -52,6 +54,7 @@
(define sandbox-output (make-parameter #f))
(define sandbox-error-output
(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-propagate-breaks (make-parameter #t))
(define sandbox-coverage-enabled (make-parameter #f))
@ -465,6 +468,7 @@
(let ([evmsg (make-evaluator-message msg '())])
(lambda (evaluator) (evaluator evmsg))))]))
(define-evaluator-messenger evaluator-alive? 'alive?)
(define-evaluator-messenger kill-evaluator 'kill)
(define-evaluator-messenger break-evaluator 'break)
(define-evaluator-messenger (set-eval-limits secs mb) 'limits)
@ -477,6 +481,7 @@
(define (make-evaluator* init-hook allow program-maker)
(define orig-cust (current-custodian))
(define user-cust (make-custodian orig-cust))
(define user-cust-box (make-custodian-box user-cust #t))
(define coverage? (sandbox-coverage-enabled))
(define uncovered #f)
(define input-ch (make-channel))
@ -569,6 +574,9 @@
(if (evaluator-message? expr)
(let ([msg (evaluator-message-msg expr)])
(case msg
[(alive?) (and (custodian-box-value user-cust-box)
user-thread
(not (thread-dead? user-thread)))]
[(kill) (user-kill)]
[(break) (user-break)]
[(limits) (set! limits (evaluator-message-args expr))]
@ -599,6 +607,10 @@
(if bytes? buf (bytes->string/utf-8 buf #\?)))))
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
(;; create a sandbox context first
[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],
which restricts file system and network access.}
@item{Each evaluation is wrapped in a @scheme[call-with-limits]; see
also @scheme[sandbox-eval-limits] and @scheme[set-eval-limits].}
@item{The evaluator is contained in a memory-restricted environment,
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
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.}
@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
(or/c (list/c (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 @scheme[make-evaluator] function, including the initial evaluation
of the input program. Its value should be a list of two numbers, the
first is a timeout value in seconds, and the second is a memory limit
in megabytes. Either one can be @scheme[#f] for disabling the
corresponding limit; alternately, the parameter can be set to
@scheme[#f] to disable all limits (useful in case more limit kinds are
available in future versions). The default is @scheme[(list 30 20)].
of the input program. Its value should be a list of two numbers;
where the first is a timeout value in seconds, and the second is a
memory limit in megabytes. Either one can be @scheme[#f] for
disabling the corresponding limit; alternately, the parameter can be
set to @scheme[#f] to disable all per-evaluation limits (useful in
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
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
around each use of the evaluator, so consuming too much time or memory
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?)]{
@ -510,6 +561,12 @@ evaluator, and the default parameter value is @scheme[current-logger].}
The following functions are used to interact with a sandboxed
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?]{
Releases the resources that are held by @scheme[evaluator] by shutting

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

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