From ab817097b429264818f92d1a86cf1ce866a986a3 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 1 Dec 2008 22:19:58 +0000 Subject: [PATCH] * Create string/bytes output port in the user's custodian (at least try to do so...). * Add tests for output collection under resources -- some are commented since they're not working right, either a bug in this code that I don't see, or some problem with memory accounting. * Clarify in the docs that output collection is still under resource limits. svn: r12667 --- collects/scheme/sandbox.ss | 15 ++++++----- collects/scribblings/reference/sandbox.scrbl | 7 ++--- collects/tests/mzscheme/sandbox.ss | 27 ++++++++++++++++++++ 3 files changed, 40 insertions(+), 9 deletions(-) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index f4e599e599..fadb043aca 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -552,14 +552,17 @@ [(output-port? out) out] [(eq? out 'pipe) (let-values ([(i o) (make-pipe)]) (set-out! i) o)] [(memq out '(bytes string)) - (let* ([bytes? (eq? 'bytes out)] - ;; the following doesn't really matter: they're the same - [out ((if bytes? open-output-bytes open-output-string))]) + (let* ([bytes? (eq? out 'bytes)] + ;; create the port under the user's custodian + [out (parameterize ([current-custodian user-cust]) + (call-in-nested-thread + ;; this doesn't really matter: they're the same anyway + (if bytes? open-output-bytes open-output-string)))]) (set-out! (lambda () - (parameterize ([current-custodian orig-cust]) - (let ([buf (get-output-bytes out #t)]) - (if bytes? buf (bytes->string/utf-8 buf #\?)))))) + ;; this will run in the user context + (let ([buf (get-output-bytes out #t)]) + (if bytes? buf (bytes->string/utf-8 buf #\?))))) out)] [else (error 'make-evaluator "bad sandox-~a spec: ~e" what out)])) (parameterize* ; the order in these matters diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl index 3db9ae43ee..dfa6c9ec07 100644 --- a/collects/scribblings/reference/sandbox.scrbl +++ b/collects/scribblings/reference/sandbox.scrbl @@ -571,9 +571,10 @@ in a way that depends on the setting of @scheme[(sandbox-output)] or input port end of the created pipe;} @item{if it was @scheme['bytes] or @scheme['string], then the result - is the accumulated output, and the output is directed to a new - output string or byte string (so each call returns a different - piece of the evaluator's output);} + is the accumulated output, and the output port is reset so each + call returns a different piece of the evaluator's output (note + that any allocations of such output are still subject to the + sandbox memory limit);} @item{otherwise, it returns @scheme[#f].} ]} diff --git a/collects/tests/mzscheme/sandbox.ss b/collects/tests/mzscheme/sandbox.ss index cacbb51478..67e5d3dc1f 100644 --- a/collects/tests/mzscheme/sandbox.ss +++ b/collects/tests/mzscheme/sandbox.ss @@ -336,6 +336,33 @@ (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" + )) (report-errs)