diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl index 2d318e3fe2..a262034127 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/sandbox.scrbl @@ -314,6 +314,20 @@ unrestricted configuration and add the desired restrictions. This approach is m possible by the @racket[call-with-trusted-sandbox-configuration] function. +The sandbox environment uses two notions of restricting the time that +evaluations takes: @tech{shallow time} and @tech{deep +time}. @deftech{Shallow time} refers to the immediate execution of an +expression. For example, a @tech{shallow time} limit of five seconds +would restrict @racket[(sleep 6)] and other computations that take +longer than five seconds. @deftech{Deep time} refers to the total +execution of the expression and all threads and sub-processes that the +expression creates. For example, a @tech{deep time} limit of five +seconds would restrict @racket[(thread (λ () (sleep 6)))], which +@tech{shallow time} would not, @emph{as well as} all expressions that +@tech{shallow time} would restrict. By default, most sandboxes only +restrict @tech{shallow time} to facilitate expressions that use +threads. + @defproc[(call-with-trusted-sandbox-configuration [thunk (-> any)]) any]{ @@ -645,15 +659,16 @@ than one block counts against the interaction limit).} (or/c (>=/c 0) #f)) #f)]{ -A @tech{parameter} that determines the default limits on @italic{each} use of -a @racket[make-evaluator] function, including the initial evaluation -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 (note that they don't have to be integers). -Either one can be @racket[#f] for disabling the corresponding limit; -alternately, the parameter can be set to @racket[#f] to disable all -per-evaluation limits (useful in case more limit kinds are available -in future versions). The default is @racket[(list 30 20)]. +A @tech{parameter} that determines the default limits on @italic{each} +use of a @racket[make-evaluator] function, including the initial +evaluation of the input program. Its value should be a list of two +numbers; where the first is a @tech{shallow time} value in seconds, +and the second is a memory limit in megabytes (note that they don't +have to be integers). Either one can be @racket[#f] for disabling the +corresponding limit; alternately, the parameter can be set to +@racket[#f] to disable all per-evaluation limits (useful in case more +limit kinds are available in future versions). The default is +@racket[(list 30 20)]. Note that these limits apply to the creation of the sandbox environment too --- even @racket[(make-evaluator 'racket/base)] can @@ -826,8 +841,8 @@ for the whole sandbox.)} void?]{ Changes the per-expression limits that @racket[evaluator] uses to -@racket[sec] seconds and @racket[mb] megabytes (either one can be -@racket[#f], indicating no limit). +@racket[secs] seconds of @tech{shallow time} and @racket[mb] +megabytes (either one can be @racket[#f], indicating no limit). This procedure should be used to modify an existing evaluator limits, because changing the @racket[sandbox-eval-limits] parameter does not @@ -989,12 +1004,12 @@ checked at the time that a sandbox evaluator is created.} Executes the given @racket[thunk] with memory and time restrictions: if execution consumes more than @racket[mb] megabytes or more than -@racket[sec] seconds, then the computation is aborted and the -@exnraise[exn:fail:resource]. Otherwise the result of the thunk is -returned as usual (a value, multiple values, or an exception). Each -of the two limits can be @racket[#f] to indicate the absence of a -limit. See also @racket[custodian-limit-memory] for information on -memory limits. +@racket[secs] @tech{shallow time} seconds, then the computation is +aborted and the @exnraise[exn:fail:resource]. Otherwise the result of +the thunk is returned as usual (a value, multiple values, or an +exception). Each of the two limits can be @racket[#f] to indicate the +absence of a limit. See also @racket[custodian-limit-memory] for +information on memory limits. Sandboxed evaluators use @racket[call-with-limits], according to the @racket[sandbox-eval-limits] setting and uses of @@ -1002,19 +1017,29 @@ Sandboxed evaluators use @racket[call-with-limits], according to the timeouts and memory problems. Use @racket[call-with-limits] directly only to limit a whole testing session, instead of each expression.} - @defform[(with-limits sec-expr mb-expr body ...)]{ A macro version of @racket[call-with-limits].} +@defproc[(call-with-deep-time-limit [secs exact-nonnegative-integer?] + [thunk (-> any)]) + any]{ + Executes the given @racket[thunk] with @tech{deep time} restrictions. +} + +@defform[(with-deep-time-limit secs-expr body ...)]{ + +A macro version of @racket[call-with-deep-time-limit].} @defproc*[([(exn:fail:resource? [v any/c]) boolean?] [(exn:fail:resource-resource [exn exn:fail:resource?]) - (or/c 'time 'memory)])]{ + (or/c 'time 'memory 'deep-time)])]{ A predicate and accessor for exceptions that are raised by -@racket[call-with-limits]. The @racket[resource] field holds a symbol, -either @racket['time] or @racket['memory].} +@racket[call-with-limits]. The @racket[resource] field holds a +symbol, representing the resource that was expended. @racket['time] is +used for @tech{shallow time} and @racket['deep-time] is used for +@tech{deep time}.} @; ---------------------------------------------------------------------- diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rkt new file mode 100644 index 0000000000..7431ca4fed --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rkt @@ -0,0 +1,51 @@ +#lang racket/base +(require racket/sandbox) + +(define (exn:fail:resource:time? x) + (and (exn:fail:resource? x) + (eq? 'deep-time (exn:fail:resource-resource x)))) + +(module+ test + (require rackunit) + + (define n 1) + (check-not-exn + (λ () + (with-deep-time-limit + n + (sleep (sub1 n))))) + (check-exn + exn:fail:resource:time? + (λ () + (with-deep-time-limit + n + (sleep (add1 n))))) + (check-exn + exn:fail:resource:time? + (λ () + (with-deep-time-limit + n + (thread (λ () (sleep (add1 n))))))) + (check-exn + exn:fail:resource:time? + (λ () + (with-deep-time-limit + n + (subprocess (current-output-port) + (current-input-port) + (current-error-port) + "/usr/bin/cat")))) + (check-exn + exn:fail:resource:time? + (λ () + (with-deep-time-limit + n + (thread (λ () + (thread (λ () (sleep (add1 n))))))))) + (check-exn + exn:fail:resource:time? + (λ () + (with-deep-time-limit + n + (parameterize ([current-custodian (make-custodian)]) + (thread (λ () (sleep (add1 n))))))))) diff --git a/pkgs/sandbox-lib/racket/sandbox.rkt b/pkgs/sandbox-lib/racket/sandbox.rkt index 4fe31764ad..829d2057a1 100644 --- a/pkgs/sandbox-lib/racket/sandbox.rkt +++ b/pkgs/sandbox-lib/racket/sandbox.rkt @@ -52,6 +52,8 @@ call-in-nested-thread* call-with-limits with-limits + call-with-deep-time-limit + with-deep-time-limit call-with-custodian-shutdown call-with-killing-threads exn:fail:sandbox-terminated? @@ -415,6 +417,54 @@ [(with-limits sec mb body ...) (call-with-limits sec mb (lambda () body ...))])) +(define (custodian-managed-list* cust super) + (define ms (custodian-managed-list cust super)) + (append-map + (λ (v) + (if (custodian? v) + (custodian-managed-list* v cust) + (list v))) + ms)) + +(define (call-with-deep-time-limit secs thunk) + (define me + (current-custodian)) + (define cust + (make-custodian me)) + (define timeout-evt + (handle-evt + (alarm-evt (+ (current-inexact-milliseconds) + (* 1000 secs))) + (λ (a) #f))) + + (parameterize ([current-custodian cust] + [current-subprocess-custodian-mode 'kill]) + (thread thunk)) + + (define r + (let loop () + (define ms (custodian-managed-list* cust me)) + (define (thread-or-subprocess? x) + (or (thread? x) + (subprocess? x))) + (define ts (filter thread-or-subprocess? ms)) + (sync + (if (empty? ts) + always-evt + (handle-evt + (apply choice-evt ts) + (λ (_) + (loop)))) + timeout-evt))) + (custodian-shutdown-all cust) + (unless r + (raise (make-exn:fail:resource (format "call-with-deep-time-limit: out of ~a" r) + (current-continuation-marks) + 'deep-time)))) + +(define-syntax-rule (with-deep-time-limit sec body ...) + (call-with-deep-time-limit sec (λ () body ...))) + ;; other resource utilities (define (call-with-custodian-shutdown thunk)