racket/sandbox: plumber

A sandbox needs it own plumber so that sandboxed code cannot attach an
arbitrary callback to the plumber outside the sandbox. The plumber
outside the sandbox gets a flush callback that tells (within the
sandbox thread) the new plumber to flush.

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]
+ @item{the symbol @racket['bytes], which causes @racket[get-output] to
-       to return the complete output as a byte string;}
+       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
+       that results are available only until the evaluator has
-       sandbox memory limit);}
+       terminated, and any allocations of the output are subject to
+       the sandbox memory limit);}
 
   @item{otherwise, it returns @racket[#f].}
 ]}

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

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))
+           (let ([p (current-plumber)])
-         h))]
+             (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)))