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

sort out for-require' vs. for-load' paths to a sandbox evaluator

Browse Source 
The two became tangled in commit f7c16fc8, and then 952ae06105
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.
This commit is contained in:
Matthew Flatt 2012-01-18 20:33:03 -07:00
parent c9e4c88b7c
commit eb0cbcb3c4
3 changed files with 186 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
collects/racket/sandbox.rkt
View File

@ -210,12 +210,12 @@
(define sandbox-make-logger (make-parameter current-logger)) (define sandbox-make-logger (make-parameter current-logger))
(define (compute-permissions paths+require-perms) (define (compute-permissions for-require for-load)
(define-values [paths require-perms] ;; `for-require' is a list of module paths and paths that will be `reqiure'd,
(partition path-string? paths+require-perms)) ;; while `for-load' is a list of path (strings) that will be `load'ed.
(define cpaths (map path->complete-path paths)) (define cpaths (map path->complete-path for-load))
(append (map (lambda (p) `(read ,(path->bytes p))) cpaths) (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 ;; 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 ;; 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 ;; 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))]) (let ([p (and (file-exists? p) (path-only p))])
(and p `(exists ,(path->bytes p))))) (and p `(exists ,(path->bytes p)))))
cpaths) cpaths)
(module-specs->path-permissions require-perms))) (module-specs->path-permissions for-require)))
;; computes permissions that are needed for require specs (`read-bytecode' for ;; computes permissions that are needed for require specs (`read-bytecode' for
;; all files and "compiled" subdirs, `exists' for the base-dir) ;; all files and "compiled" subdirs, `exists' for the base-dir)
@ -253,6 +253,8 @@
(cond [(and (pair? mod) (eq? 'lib (car mod))) #f] (cond [(and (pair? mod) (eq? 'lib (car mod))) #f]
[(module-path? mod) [(module-path? mod)
(simplify-path* (resolve-module-path mod #f))] (simplify-path* (resolve-module-path mod #f))]
[(path? mod)
(simplify-path* mod)]
[(not (and (pair? mod) (pair? (cdr mod)))) [(not (and (pair? mod) (pair? (cdr mod))))
;; don't know what this is, leave as is ;; don't know what this is, leave as is
#f] #f]
@ -660,7 +662,7 @@
(current-continuation-marks) (current-continuation-marks)
reason)) 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-code-inspector (current-code-inspector))
(define orig-security-guard (current-security-guard)) (define orig-security-guard (current-security-guard))
(define orig-cust (current-custodian)) (define orig-cust (current-custodian))
@ -891,7 +893,7 @@
(exists ,(find-system-path 'addon-dir)) (exists ,(find-system-path 'addon-dir))
(read ,(find-system-path 'links-file)) (read ,(find-system-path 'links-file))
(read ,(find-lib-dir)) (read ,(find-lib-dir))
,@(compute-permissions allow) ,@(compute-permissions allow-for-require allow-for-load)
,@(sandbox-path-permissions))] ,@(sandbox-path-permissions))]
;; restrict the sandbox context from this point ;; restrict the sandbox context from this point
[current-security-guard [current-security-guard
@ -960,32 +962,78 @@
;; program didn't execute ;; program didn't execute
(raise r))) (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 (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)
;; `input-program' is either a single argument specifying a file/string, or ;; `input-program' is either a single argument specifying a file/string, or
;; multiple arguments for a sequence of expressions ;; multiple arguments for a sequence of expressions
;; make it possible to use simple paths to files to require (define all-requires
(define reqs (if (not (list? requires)) (extract-required (or (decode-language lang) lang)
(error 'make-evaluator "bad requires: ~e" requires) requires))
(map (lambda (r) (unless (and (list? requires)
(if (or (pair? r) (symbol? r)) (andmap (lambda (x) (or (path-string? x)
r (module-path? x)
`(file ,(path->string (simplify-path* r))))) (and (list? x)
requires))) (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 (make-evaluator* 'make-evaluator
(init-hook-for-language lang) (init-hook-for-language lang)
(append (extract-required (or (decode-language lang) lang) (append (apply append
reqs) (map normalize-require-for-allow all-requires))
(if (and (= 1 (length input-program)) all-for-require)
(append (if (and (= 1 (length input-program))
(path? (car input-program))) (path? (car input-program)))
(list (car input-program)) (list (car input-program))
'()) '())
allow) all-for-load)
(lambda () (build-program lang reqs input-program)))) (lambda () (build-program lang
(map normalize-require-for-syntax all-requires)
input-program))))
(define (make-module-evaluator (define (make-module-evaluator input-program
input-program #:allow-read [allow null] #:language [reqlang #f]) #: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 ;; this is for a complete module input program
(define (make-program) (define (make-program)
(define-values [prog source] (define-values [prog source]
@ -1005,7 +1053,10 @@
[_else (error 'make-module-evaluator [_else (error 'make-module-evaluator
"expecting a `module' program; got ~.s" "expecting a `module' program; got ~.s"
(syntax->datum (car prog)))])) (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 (make-evaluator* 'make-module-evaluator
void 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)) make-program))

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

@ -23,12 +23,19 @@ for the common use case where sandboxes are very limited.
(list/c 'special symbol?) (list/c 'special symbol?)
(cons/c 'begin list?))] (cons/c 'begin list?))]
[input-program any/c] ... [input-program any/c] ...
[#:requires requires (listof (or/c module-path? path?))] [#:requires requires
[#:allow-read allow (listof (or/c module-path? path?))]) (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)] (any/c . -> . any)]
[(make-module-evaluator [module-decl (or/c syntax? pair?)] [(make-module-evaluator [module-decl (or/c syntax? pair? path? input-port? string? bytes?)]
[#:language lang (or/c #f module-path?)] [#:language lang (or/c #f module-path?) #f]
[#:allow-read allow (listof (or/c module-path? path?))]) [#: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)])]{ (any/c . -> . any)])]{
The @racket[make-evaluator] function creates an evaluator with a 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. function for further evaluation.
The returned evaluator operates in an isolated and limited The returned evaluator operates in an isolated and limited
environment. In particular, filesystem access is restricted. The environment. In particular, filesystem access is restricted, which may
@racket[allow] argument extends the set of files that are readable by interfere with using modules from the filesystem. See below for
the evaluator to include the specified modules and their imports information on the @racket[allow-for-require],
(transitively). When @racket[language] is a module path and when @racket[allow-for-load], and @racket[allow-read] arguments. When
@racket[requires] is provided, the indicated modules are implicitly @racket[language] is a module path or when @racket[requires] is
included in the @racket[allow] list. 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 Each @racket[input-program] or @racket[module-decl] argument provides
a program in one of the following forms: 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 useful to restrict the program to be a module using a spcific module
in its language position --- use the optional @racket[lang] argument in its language position --- use the optional @racket[lang] argument
to specify such a restriction (the default, @racket[#f], means no 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[ @racketblock[
(define base-module-eval2 (define base-module-eval2
@ -167,8 +179,8 @@ restriction is enforced).
(define later 5)))) (define later 5))))
] ]
@racket[make-module-evaluator] can be very convenient for testing The @racket[make-module-evaluator] function can be convenient for testing
module files: all you need to do is pass in a path value for the file module files: pass in a path value for the file
name, and you get back an evaluator in the module's context which you name, and you get back an evaluator in the module's context which you
can use with your favorite test facility. 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 create the sandbox is higher than the limit, then
@racket[make-evaluator] will fail with a memory limit exception. @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 The sandboxed evironment is well isolated, and the evaluator function
essentially sends it an expression and waits for a result. This form essentially sends it an expression and waits for a result. This form
of communication makes it impossible to have nested (or concurrent) of communication makes it impossible to have nested (or concurrent)

74
collects/tests/racket/sandbox.rktl
View File

@ -36,14 +36,14 @@
(test 'shut (lambda () (nested* (shut))))) (test 'shut (lambda () (nested* (shut)))))
(let ([ev void]) (let ([ev void])
(define (make-evaluator! . args) (define (make-evaluator! #:requires [reqs null] . args)
(set! ev (apply make-evaluator args))) (set! ev (apply make-evaluator args #:requires reqs)))
(define (make-base-evaluator! . args) (define (make-base-evaluator! . args)
(set! ev (apply make-evaluator 'racket/base args))) (set! ev (apply make-evaluator 'racket/base args)))
(define (make-base-evaluator/reqs! reqs . args) (define (make-base-evaluator/reqs! reqs . args)
(set! ev (apply make-evaluator 'racket/base #:requires reqs args))) (set! ev (apply make-evaluator 'racket/base #:requires reqs args)))
(define (make-module-evaluator! . args) (define (make-module-evaluator! #:allow-read [allow null] . args)
(set! ev (apply make-module-evaluator args))) (set! ev (apply make-module-evaluator args #:allow-read allow)))
(define (run thunk) (define (run thunk)
(with-handlers ([void (lambda (e) (list 'exn: e))]) (with-handlers ([void (lambda (e) (list 'exn: e))])
(call-with-values thunk (lambda vs (cons 'vals: vs))))) (call-with-values thunk (lambda vs (cons 'vals: vs)))))
@ -281,6 +281,13 @@
x => 1 x => 1
(define x 2) =err> "cannot re-define a constant" (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 ;; limited FS access, allowed for requires
--top-- --top--
(let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)] (let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)]
@ -291,7 +298,23 @@
[test-lib (strpath tmp "sandbox-test.rkt")] [test-lib (strpath tmp "sandbox-test.rkt")]
[test-zo (strpath tmp "compiled" "sandbox-test_rkt.zo")] [test-zo (strpath tmp "compiled" "sandbox-test_rkt.zo")]
[test2-lib (strpath tmp "sandbox-test2.rkt")] [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-- (t --top--
(make-base-evaluator!) (make-base-evaluator!)
--eval-- --eval--
@ -320,6 +343,47 @@
;; the directory is still not kosher ;; the directory is still not kosher
(directory-list ,tmp) =err> "`read' access denied" (directory-list ,tmp) =err> "`read' access denied"
--top-- --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 ;; require it
(make-base-evaluator/reqs! `(,test-lib)) (make-base-evaluator/reqs! `(,test-lib))
--eval-- --eval--