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

101
collects/racket/sandbox.rkt
View File

@ -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)))
(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))))
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))

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?)
(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)

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

@ -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--