diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl index a262034127..5f49c1ffbb 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl @@ -334,7 +334,7 @@ threads. Invokes the @racket[thunk] in a context where sandbox configuration parameters are set for minimal restrictions. More specifically, there are no memory or time limits, and the existing existing @tech{inspectors}, -@tech{security guard}, @tech{exit handler}, @tech{logger}, and +@tech{security guard}, @tech{exit handler}, @tech{logger}, @tech{plumber}, and @tech{environment variable set} are used. (Note that the I/O ports settings are not included.)} @@ -411,8 +411,10 @@ values are allowed: @item{an output port, which is used as-is;} - @item{the symbol @racket['bytes], which causes @racket[get-output] - to return the complete output as a byte string;} + @item{the symbol @racket['bytes], which causes @racket[get-output] to + return the complete output as a byte string as long as the + evaluator has not yet terminated (so that the size of the bytes + can be charged to the evaluator);} @item{the symbol @racket['string], which is similar to @racket['bytes], but makes @racket[get-output] produce a @@ -781,6 +783,20 @@ an evaluator, and the default parameter value is logger (this might change in the future).} +@defparam[sandbox-make-plumber make (or/c (-> plumber?) 'propagate)]{ + +A @tech{parameter} that determines the procedure used to create the +plumber for sandboxed evaluation. The procedure is called when +initializing an evaluator. + +If the value is @racket['propagate] (the default), then a new plumber +is created, and a @tech{flush callback} is added to the current +plumber to propagate the request to the new plumber within the created +sandbox (if the sandbox has not already terminated). + +@history[#:added "6.0.1.8"]} + + @defparam[sandbox-make-environment-variables make (-> environment-variables?)]{ A @tech{parameter} that determines the procedure used to create the @@ -902,8 +918,9 @@ in a way that depends on the setting of @racket[(sandbox-output)] or @item{if it was @racket['bytes] or @racket['string], then the result 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);} + that results are available only until the evaluator has + terminated, and any allocations of the output are subject to + the sandbox memory limit);} @item{otherwise, it returns @racket[#f].} ]} diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rktl index 29c3ac99af..261bb8f4f8 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rktl @@ -36,7 +36,9 @@ (test 'shut (lambda () (nested* (shut))))) (let ([ev void] - [old-port #f]) + [old-port #f] + [plumber (make-plumber)] + [out-port (open-output-bytes)]) (define (make-evaluator! #:requires [reqs null] . args) (set! ev (apply make-evaluator args #:requires reqs))) (define (make-base-evaluator! . args) @@ -597,6 +599,29 @@ --top-- (getenv "PEAR") => #f + --top-- + (parameterize ([sandbox-output (lambda () out-port)] + [current-plumber plumber]) + (make-base-evaluator!)) + (plumber-add-flush! plumber (lambda (h) (set! plumber #f))) + (get-output-string out-port) => "" + --eval-- + (plumber-flush-all (current-plumber)) ; should not affect `plumber` + (plumber-add-flush! (current-plumber) (lambda (h) (displayln "flushed"))) + --top-- + (not plumber) => #f + (get-output-string out-port) => "" + (plumber-flush-all plumber) + plumber => #f + --eval-- + 10 => 10 ; sync, so that flush has been propagated + --top-- + (get-output-string out-port) => "flushed\n" + --eval-- + (exit) =err> "terminated .exited.$" + --top-- + (get-output-string out-port) => "flushed\nflushed\n" + ;; tests for specials --top-- ;; these are conditional so that we can run diff --git a/pkgs/sandbox-lib/racket/sandbox.rkt b/pkgs/sandbox-lib/racket/sandbox.rkt index cda994ccaa..b157bfceaf 100644 --- a/pkgs/sandbox-lib/racket/sandbox.rkt +++ b/pkgs/sandbox-lib/racket/sandbox.rkt @@ -30,6 +30,7 @@ sandbox-make-inspector sandbox-make-code-inspector sandbox-make-logger + sandbox-make-plumber sandbox-make-environment-variables sandbox-memory-limit sandbox-eval-limits @@ -95,6 +96,7 @@ [sandbox-make-inspector current-inspector] [sandbox-make-code-inspector current-code-inspector] [sandbox-make-logger current-logger] + [sandbox-make-plumber (lambda () (current-plumber))] [sandbox-make-environment-variables current-environment-variables] [sandbox-memory-limit #f] [sandbox-eval-limits #f] @@ -237,6 +239,8 @@ (define sandbox-make-logger (make-parameter current-logger)) +(define sandbox-make-plumber (make-parameter 'propagate)) + (define sandbox-make-environment-variables (make-parameter (lambda () (environment-variables-copy @@ -1020,6 +1024,26 @@ [current-security-guard (let ([g (sandbox-security-guard)]) (if (security-guard? g) g (g)))] [current-logger ((sandbox-make-logger))] + [current-plumber + (let ([maker (sandbox-make-plumber)]) + (if (eq? maker 'propagate) + ;; Create a new plumber, but cause flushes to the original + ;; plumber schedule a flush in the sandbox: + (let ([p (make-plumber)]) + (define fh (plumber-add-flush! (current-plumber) + (lambda (fh) + (unless terminated? + (call-in-sandbox-context + evaluator + (lambda () + (plumber-flush-all p))))) + ;; weak: + #t)) + ;; Retain flush propagation as long as the new plumber is + ;; reachable: + (plumber-add-flush! p (lambda (_) fh)) + p) + (maker)))] [current-inspector ((sandbox-make-inspector))] [current-code-inspector ((sandbox-make-code-inspector))] ;; The code inspector serves two purposes -- making sure that only trusted @@ -1059,8 +1083,11 @@ [exit-handler (let ([h (sandbox-exit-handler)]) (if (eq? h default-sandbox-exit-handler) - (lambda _ (terminate+kill! 'exited #f)) - h))] + (let ([p (current-plumber)]) + (lambda _ + (plumber-flush-all p) + (terminate+kill! 'exited #f))) + h))] ;; general info [current-command-line-arguments '#()] ;; Finally, create the namespace in the restricted environment (in @@ -1079,7 +1106,7 @@ (define bg-run->thread (if (sandbox-gui-available) (lambda (ignored) ((mz/mr void eventspace-handler-thread) (current-eventspace))) - values)) + values)) (define t (bg-run->thread (run-in-bg user-process))) (set! user-done-evt (handle-evt t (lambda (_) (terminate+kill! #t #t)))) (set! user-thread t)))