From eb0cbcb3c438d55dde63d68b1249ff298959c552 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 18 Jan 2012 20:33:03 -0700 Subject: [PATCH] sort out for-`require' vs. for-`load' paths to a sandbox evaluator The two became tangled in commit f7c16fc8, and then 952ae06105fe adjusted the tangling in a way that broke code. This commit further adjusts tangling in a way that hopefully causes fewer compatibility problems, but it also splits inputs to `make-evaluator' so that a programmer can choose more explicitly. --- collects/racket/sandbox.rkt | 107 ++++++++++++++----- collects/scribblings/reference/sandbox.scrbl | 52 ++++++--- collects/tests/racket/sandbox.rktl | 74 ++++++++++++- 3 files changed, 186 insertions(+), 47 deletions(-) diff --git a/collects/racket/sandbox.rkt b/collects/racket/sandbox.rkt index cfd86d0c86..70aed425a8 100644 --- a/collects/racket/sandbox.rkt +++ b/collects/racket/sandbox.rkt @@ -210,12 +210,12 @@ (define sandbox-make-logger (make-parameter current-logger)) -(define (compute-permissions paths+require-perms) - (define-values [paths require-perms] - (partition path-string? paths+require-perms)) - (define cpaths (map path->complete-path paths)) +(define (compute-permissions for-require for-load) + ;; `for-require' is a list of module paths and paths that will be `reqiure'd, + ;; while `for-load' is a list of path (strings) that will be `load'ed. + (define cpaths (map path->complete-path for-load)) (append (map (lambda (p) `(read ,(path->bytes p))) cpaths) - ;; when reading a file from "/foo/bar/baz.rkt" racket will try to see + ;; when loading a module from "/foo/bar/baz.rkt" racket will try to see ;; if "/foo/bar" exists, so allow these paths too; it might be needed ;; to allow 'exists on any parent path, but I'm not sure that this is ;; safe in terms of security, so put just the immediate parent dir in @@ -223,7 +223,7 @@ (let ([p (and (file-exists? p) (path-only p))]) (and p `(exists ,(path->bytes p))))) cpaths) - (module-specs->path-permissions require-perms))) + (module-specs->path-permissions for-require))) ;; computes permissions that are needed for require specs (`read-bytecode' for ;; all files and "compiled" subdirs, `exists' for the base-dir) @@ -253,6 +253,8 @@ (cond [(and (pair? mod) (eq? 'lib (car mod))) #f] [(module-path? mod) (simplify-path* (resolve-module-path mod #f))] + [(path? mod) + (simplify-path* mod)] [(not (and (pair? mod) (pair? (cdr mod)))) ;; don't know what this is, leave as is #f] @@ -660,7 +662,7 @@ (current-continuation-marks) reason)) -(define (make-evaluator* who init-hook allow program-maker) +(define (make-evaluator* who init-hook allow-for-require allow-for-load program-maker) (define orig-code-inspector (current-code-inspector)) (define orig-security-guard (current-security-guard)) (define orig-cust (current-custodian)) @@ -891,7 +893,7 @@ (exists ,(find-system-path 'addon-dir)) (read ,(find-system-path 'links-file)) (read ,(find-lib-dir)) - ,@(compute-permissions allow) + ,@(compute-permissions allow-for-require allow-for-load) ,@(sandbox-path-permissions))] ;; restrict the sandbox context from this point [current-security-guard @@ -960,32 +962,78 @@ ;; program didn't execute (raise r))) +(define (check-and-combine-allows who allow allow-for-require allow-for-load) + (define (check-arg-list arg what ok?) + (unless (and (list? arg) (andmap ok? arg)) + (error who "bad ~a: ~e" what arg))) + (check-arg-list allow "allows" + (lambda (x) (or (path? x) (module-path? x) (path-string? x)))) + (check-arg-list allow-for-require "allow-for-requires" + (lambda (x) (or (path? x) (module-path? x)))) + (check-arg-list allow-for-load "allow-for-loads" path-string?) + ;; This split of `allow' is ugly but backward-compatible: + (define-values (more-allow-for-load more-allow-for-require) + (partition (lambda (p) (or (path? p) + ;; strings that can be treated as paths: + (not (module-path? p)))) + allow)) + (values (append allow-for-require + more-allow-for-require) + (append allow-for-load + more-allow-for-load))) + (define (make-evaluator lang - #:requires [requires null] #:allow-read [allow null] + #:requires [requires null] + #:allow-read [allow null] + #:allow-for-require [allow-for-require null] + #:allow-for-load [allow-for-load null] . input-program) ;; `input-program' is either a single argument specifying a file/string, or - ;; multiple arguments for a sequence of expressions - ;; make it possible to use simple paths to files to require - (define reqs (if (not (list? requires)) - (error 'make-evaluator "bad requires: ~e" requires) - (map (lambda (r) - (if (or (pair? r) (symbol? r)) - r - `(file ,(path->string (simplify-path* r))))) - requires))) + ;; multiple arguments for a sequence of expressions + (define all-requires + (extract-required (or (decode-language lang) lang) + requires)) + (unless (and (list? requires) + (andmap (lambda (x) (or (path-string? x) + (module-path? x) + (and (list? x) + (pair? x) + (eq? (car x) 'for-syntax) + (andmap module-path? (cdr x))))) + requires)) + (error 'make-evaluator "bad requires: ~e" requires)) + (define-values (all-for-require all-for-load) + (check-and-combine-allows 'make-evaluator allow allow-for-require allow-for-load)) + (define (normalize-require-for-syntax r) + (if (or (path? r) (and (string? r) + (not (module-path? r)))) + `(file ,(path->string (simplify-path* r))) + r)) + (define (normalize-require-for-allow r) + (cond + [(and (string? r) (not (module-path? r))) (list (string->path r))] + [(and (pair? r) (eq? (car r) 'for-syntax)) + (cdr r)] + [else (list r)])) (make-evaluator* 'make-evaluator (init-hook-for-language lang) - (append (extract-required (or (decode-language lang) lang) - reqs) - (if (and (= 1 (length input-program)) + (append (apply append + (map normalize-require-for-allow all-requires)) + all-for-require) + (append (if (and (= 1 (length input-program)) (path? (car input-program))) - (list (car input-program)) - '()) - allow) - (lambda () (build-program lang reqs input-program)))) + (list (car input-program)) + '()) + all-for-load) + (lambda () (build-program lang + (map normalize-require-for-syntax all-requires) + input-program)))) -(define (make-module-evaluator - input-program #:allow-read [allow null] #:language [reqlang #f]) +(define (make-module-evaluator input-program + #:allow-read [allow null] + #:allow-for-require [allow-for-require null] + #:allow-for-load [allow-for-load null] + #:language [reqlang #f]) ;; this is for a complete module input program (define (make-program) (define-values [prog source] @@ -1005,7 +1053,10 @@ [_else (error 'make-module-evaluator "expecting a `module' program; got ~.s" (syntax->datum (car prog)))])) + (define-values (all-for-require all-for-load) + (check-and-combine-allows 'make-module-evaluator allow allow-for-require allow-for-load)) (make-evaluator* 'make-module-evaluator void - (if (path? input-program) (cons input-program allow) allow) + all-for-require + (if (path? input-program) (cons input-program all-for-load) all-for-load) make-program)) diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl index 3a3b6966af..b83022edfb 100644 --- a/collects/scribblings/reference/sandbox.scrbl +++ b/collects/scribblings/reference/sandbox.scrbl @@ -23,12 +23,19 @@ for the common use case where sandboxes are very limited. (list/c 'special symbol?) (cons/c 'begin list?))] [input-program any/c] ... - [#:requires requires (listof (or/c module-path? path?))] - [#:allow-read allow (listof (or/c module-path? path?))]) + [#:requires requires + (listof (or/c module-path? path-string? + (cons/c 'for-syntax (listof module-path?)))) + null] + [#:allow-for-require allow-for-require (listof (or/c module-path? path?)) null] + [#:allow-for-load allow-for-load (listof path-string?) null] + [#:allow-read allow-read (listof (or/c module-path? path-string?)) null]) (any/c . -> . any)] - [(make-module-evaluator [module-decl (or/c syntax? pair?)] - [#:language lang (or/c #f module-path?)] - [#:allow-read allow (listof (or/c module-path? path?))]) + [(make-module-evaluator [module-decl (or/c syntax? pair? path? input-port? string? bytes?)] + [#:language lang (or/c #f module-path?) #f] + [#:allow-for-require allow-for-require (listof (or/c module-path? path?)) null] + [#:allow-for-load allow-for-load (listof path-string?) null] + [#:allow-read allow-read (listof (or/c module-path? path-string?)) null]) (any/c . -> . any)])]{ The @racket[make-evaluator] function creates an evaluator with a @@ -39,12 +46,16 @@ works in the context of a given module. The result in either case is a function for further evaluation. The returned evaluator operates in an isolated and limited -environment. In particular, filesystem access is restricted. The -@racket[allow] argument extends the set of files that are readable by -the evaluator to include the specified modules and their imports -(transitively). When @racket[language] is a module path and when -@racket[requires] is provided, the indicated modules are implicitly -included in the @racket[allow] list. +environment. In particular, filesystem access is restricted, which may +interfere with using modules from the filesystem. See below for +information on the @racket[allow-for-require], +@racket[allow-for-load], and @racket[allow-read] arguments. When +@racket[language] is a module path or when @racket[requires] is +provided, the indicated modules are implicitly included in the +@racket[allow-for-require] list. (For backward compatibility, +non-@racket[module-path?] path strings are allowed in +@racket[requires]; they are implicitly converted to paths before +addition to @racket[allow-for-require].) Each @racket[input-program] or @racket[module-decl] argument provides a program in one of the following forms: @@ -157,7 +168,8 @@ module, and all imports are part of the program. In some cases it is useful to restrict the program to be a module using a spcific module in its language position --- use the optional @racket[lang] argument to specify such a restriction (the default, @racket[#f], means no -restriction is enforced). +restriction is enforced). When the program is specified as a path, then +the path is implicitly added to the @racket[allow-for-load] list. @racketblock[ (define base-module-eval2 @@ -167,8 +179,8 @@ restriction is enforced). (define later 5)))) ] -@racket[make-module-evaluator] can be very convenient for testing -module files: all you need to do is pass in a path value for the file +The @racket[make-module-evaluator] function can be convenient for testing +module files: pass in a path value for the file name, and you get back an evaluator in the module's context which you can use with your favorite test facility. @@ -193,6 +205,18 @@ environment too --- so, for example, if the memory that is required to create the sandbox is higher than the limit, then @racket[make-evaluator] will fail with a memory limit exception. +The @racket[allow-for-require] and @racket[allow-for-load] arguments +adjust filesystem permissions to extend the set of files that +are usable by the evaluator. The @racket[allow-for-require] argument lists +modules that can be @racket[require]d along with their imports +(transitively). The @racket[allow-for-load] argument lists files that can +be @racket[load]ed. (The precise permissions needed for +@racket[require] versus @racket[load] can differ.) The +@racket[allow-read] argument is for backward compatibility, only; each +@racket[module-path?] element of @racket[allow-read] is effectively +moved to @racket[allow-for-require], while other elements are moved to +@racket[all-for-load]. + The sandboxed evironment is well isolated, and the evaluator function essentially sends it an expression and waits for a result. This form of communication makes it impossible to have nested (or concurrent) diff --git a/collects/tests/racket/sandbox.rktl b/collects/tests/racket/sandbox.rktl index aba37edf1d..77eb873d68 100644 --- a/collects/tests/racket/sandbox.rktl +++ b/collects/tests/racket/sandbox.rktl @@ -36,14 +36,14 @@ (test 'shut (lambda () (nested* (shut))))) (let ([ev void]) - (define (make-evaluator! . args) - (set! ev (apply make-evaluator args))) + (define (make-evaluator! #:requires [reqs null] . args) + (set! ev (apply make-evaluator args #:requires reqs))) (define (make-base-evaluator! . args) (set! ev (apply make-evaluator 'racket/base args))) (define (make-base-evaluator/reqs! reqs . args) (set! ev (apply make-evaluator 'racket/base #:requires reqs args))) - (define (make-module-evaluator! . args) - (set! ev (apply make-module-evaluator args))) + (define (make-module-evaluator! #:allow-read [allow null] . args) + (set! ev (apply make-module-evaluator args #:allow-read allow))) (define (run thunk) (with-handlers ([void (lambda (e) (list 'exn: e))]) (call-with-values thunk (lambda vs (cons 'vals: vs))))) @@ -281,6 +281,13 @@ x => 1 (define x 2) =err> "cannot re-define a constant" + ;; `for-syntax' is allowed in #:requires: + --top-- + (make-evaluator! 'scheme/base #:requires '((for-syntax racket/base))) + --eval-- + (define-syntax (m stx) #'10) + m => 10 + ;; limited FS access, allowed for requires --top-- (let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)] @@ -291,7 +298,23 @@ [test-lib (strpath tmp "sandbox-test.rkt")] [test-zo (strpath tmp "compiled" "sandbox-test_rkt.zo")] [test2-lib (strpath tmp "sandbox-test2.rkt")] - [test2-zo (strpath tmp "compiled" "sandbox-test2_rkt.zo")]) + [test2-zo (strpath tmp "compiled" "sandbox-test2_rkt.zo")] + [test3-file "sandbox-test3.rkt"] + [test3-lib (strpath tmp test3-file)] + [make-module-evaluator/rel (lambda (mod + #:allow-read [allow null] + #:allow-for-require [allow-for-require null] + #:allow-for-load [allow-for-load null]) + (parameterize ([current-directory tmp] + [current-load-relative-directory tmp]) + (make-module-evaluator mod + #:allow-read allow + #:allow-for-require allow-for-require + #:allow-for-load allow-for-load)))] + [make-evaluator/rel (lambda (lang) + (parameterize ([current-directory tmp] + [current-load-relative-directory tmp]) + (make-evaluator lang)))]) (t --top-- (make-base-evaluator!) --eval-- @@ -320,6 +343,47 @@ ;; the directory is still not kosher (directory-list ,tmp) =err> "`read' access denied" --top-- + ;; ports, strings, and bytes are also allowed, but in the case + ;; of ports, we have to specificaly enable access to the + ;; enclosing directory, since the port name connects it to the + ;; directory, and some part of the module infrastructure exploits that: + (make-module-evaluator! + (open-input-file (string->path test-lib))) =err> "`exists' access denied" + (make-module-evaluator! (open-input-file (string->path test-lib)) + ;; allowing a file read indirectly allows containing-directory + ;; existence check: + #:allow-read (list (string->path test-lib))) + (make-module-evaluator! (file->string (string->path test-lib))) + (make-module-evaluator! (file->bytes (string->path test-lib))) + --top-- + ;; a relative-path string should work as a module to be `require'd, + ;; as opposed to a module to be `load'ed: + (with-output-to-file test3-lib + (lambda () + (printf "~s\n" '(module sandbox-test racket/base + (provide #%module-begin))))) + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-read (list test3-file)) + ;; for-require is more clear: + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-for-require (list test3-file)) + ;; for-load isn't ok: + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-for-load (list test3-file)) + =err> "`read' access denied" + ;; an absolute path is treated like `for-load': + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-read (list test3-lib)) + =err> "`read' access denied" + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-read (list (string->path test3-lib))) + =err> "`read' access denied" + ;; an absolute path with `for-require' is ok: + (make-module-evaluator/rel `(module m ,test3-file) + #:allow-for-require (list (string->path test3-lib))) + ;; make sure that the language is treated as a require: + (make-evaluator/rel test3-file) + --top-- ;; require it (make-base-evaluator/reqs! `(,test-lib)) --eval--