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

* Create string/bytes output port in the user's custodian (at least

Browse Source 
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
This commit is contained in:
Eli Barzilay 2008-12-01 22:19:58 +00:00
parent 12467b4ecd
commit ab817097b4
3 changed files with 40 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/scheme/sandbox.ss
View File

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

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

@ -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].}
]}

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

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