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

Finally enabled using a sub code-inspector properly, with a new

Browse Source 
'read-bytecode permission mode.  Added tests and (crappily)
documented.

svn: r12846
This commit is contained in:
Eli Barzilay 2008-12-15 01:07:00 +00:00
parent acf3324659
commit c62595772f
3 changed files with 185 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
collects/scheme/sandbox.ss
View File

@ -94,9 +94,14 @@
[(string? path) (string->path path)]
[else path]))))))
(define permission-order '(execute write delete read exists))
;; 'read-bytecode is special, it's higher than 'read, but not lower than
;; 'delete.
(define permission-order '(execute write delete read-bytecode read exists))
(define (perm<=? p1 p2)
(memq p1 (memq p2 permission-order)))
(or (eq? p1 p2)
(and (not (eq? 'read-bytecode p1))
(memq p1 (memq p2 permission-order))
#t)))
;; gets a path (can be bytes/string), returns a regexp for that path that
;; matches also subdirs (if it's a directory)
@ -117,6 +122,29 @@
(map (lambda (perm) (list (car perm) (path->bregexp (cadr perm))))
new))))
;; compresses the (sandbox-path-permissions) value to a "compressed" list of
;; (permission regexp ...) where each permission appears exactly once (so it's
;; quicker to test it later, no need to scan the whole permission list).
(define compressed-path-permissions
(let ([t (make-weak-hasheq)])
(define (compress-permissions ps)
(map (lambda (perm)
(let* ([ps (filter (lambda (p) (perm<=? perm (car p))) ps)]
[ps (remove-duplicates (map cadr ps))])
(cons perm ps)))
permission-order))
(lambda ()
(let ([ps (sandbox-path-permissions)])
(or (hash-ref t ps #f)
(let ([c (compress-permissions ps)]) (hash-set! t ps c) c))))))
;; similar to the security guard, only with a single mode for simplification;
;; assumes valid mode and simplified path
(define (check-sandbox-path-permissions path needed)
(let ([bpath (path->bytes path)]
[perms (compressed-path-permissions)])
(ormap (lambda (rx) (regexp-match? rx bpath)) (cdr (assq needed perms)))))
(define sandbox-network-guard
(make-parameter (lambda (what . xs)
(error what "network access denied: ~e" xs))))
@ -127,16 +155,17 @@
orig-security
(lambda (what path modes)
(when path
(let ([needed (car (or (for/or ([p (in-list permission-order)])
(memq p modes))
(error 'default-sandbox-guard
"unknown access modes: ~e" modes)))]
[bpath (parameterize ([current-security-guard orig-security])
(path->bytes (simplify-path* path)))])
(unless (ormap (lambda (perm)
(and (perm<=? needed (car perm))
(regexp-match (cadr perm) bpath)))
(sandbox-path-permissions))
(let ([spath (parameterize ([current-security-guard orig-security])
(simplify-path* path))]
[maxperm
;; assumes that the modes are valid (ie, in the above list)
(cond [(null? modes) (error 'default-sandbox-guard
"got empty mode list for ~e and ~e"
what path)]
[(null? (cdr modes)) (car modes)] ; common case
[else (foldl (lambda (x max) (if (perm<=? max x) x max))
(car modes) (cdr modes))])])
(unless (check-sandbox-path-permissions spath maxperm)
(error what "`~a' access denied for ~a"
(string-append* (add-between (map symbol->string modes) "+"))
path)))))
@ -168,8 +197,8 @@
(append (map (lambda (p) `(read ,(path->bytes p))) paths)
(module-specs->path-permissions require-perms))))
;; computes permissions that are needed for require specs (`read' for all
;; files and "compiled" subdirs, `exists' for the base-dir)
;; computes permissions that are needed for require specs (`read-bytecode' for
;; all files and "compiled" subdirs, `exists' for the base-dir)
(define (module-specs->path-permissions mods)
(define paths (module-specs->non-lib-paths mods))
(define bases
@ -180,8 +209,8 @@
(let ([base (simplify-path* base)])
(loop (cdr paths)
(if (member base bases) bases (cons base bases))))))))
(append (map (lambda (p) `(read ,p)) paths)
(map (lambda (b) `(read ,(build-path b "compiled"))) bases)
(append (map (lambda (p) `(read-bytecode ,p)) paths)
(map (lambda (b) `(read-bytecode ,(build-path b "compiled"))) bases)
(map (lambda (b) `(exists ,b)) bases)))
;; takes a module-spec list and returns all module paths that are needed
@ -526,6 +555,7 @@
(define (make-evaluator* init-hook allow program-maker)
(define orig-code-inspector (current-code-inspector))
(define orig-security-guard (current-security-guard))
(define orig-cust (current-custodian))
(define memory-cust (make-custodian orig-cust))
(define memory-cust-box (make-custodian-box memory-cust #t))
@ -707,7 +737,7 @@
(append (sandbox-override-collection-paths)
(current-library-collection-paths)))]
[sandbox-path-permissions
(append (map (lambda (p) `(read ,p))
(append (map (lambda (p) `(read-bytecode ,p))
(current-library-collection-paths))
(compute-permissions allow)
(sandbox-path-permissions))]
@ -716,24 +746,31 @@
;; restrict the sandbox context from this point
[current-security-guard
(let ([g (sandbox-security-guard)]) (if (security-guard? g) g (g)))]
[current-logger ((sandbox-make-logger))]
[current-inspector ((sandbox-make-inspector))]
[current-code-inspector ((sandbox-make-code-inspector))]
;; The code inspector serves two purposes -- making sure that only trusted
;; byte-code is loaded, and avoiding using protected module bindings, like
;; the foreign library's `unsafe!'. We control the first through the path
;; permissions -- using the 'read-bytecode permissionn level, so this
;; handler just checks for that permission then goes on to load the file
;; using the original inspector.
[current-load/use-compiled
(let ([handler (current-load/use-compiled)])
(lambda (path modname)
(if (check-sandbox-path-permissions
(parameterize ([current-security-guard orig-security-guard])
(simplify-path* path))
'read-bytecode)
(parameterize ([current-code-inspector orig-code-inspector])
(handler path modname))
;; otherwise, just let the old handler throw a proper error
(handler path modname))))]
[exit-handler
(let ([h (sandbox-exit-handler)])
(if (eq? h default-sandbox-exit-handler)
(lambda _ (terminated! 'exited) (user-kill))
h))]
[current-inspector ((sandbox-make-inspector))]
[current-logger ((sandbox-make-logger))]
[current-code-inspector (make-inspector)]
;; The code inspector serves two purposes -- making sure that only trusted
;; byte-code is loaded, and avoiding using protected moduel bindings, like
;; the foreign library's `unsafe!'. We don't need the first because we
;; control it indirectly through the security guard, so this handler makes
;; sure that byte-code is loaded using the original inspector.
[current-load/use-compiled
(let ([handler (current-load/use-compiled)])
(lambda (path modname)
(parameterize ([current-code-inspector orig-code-inspector])
(handler path modname))))]
;; Note the above definition of `current-eventspace': in MzScheme, it
;; is an unused parameter. Also note that creating an eventspace
;; starts a thread that will eventually run the callback code (which

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

@ -443,7 +443,7 @@ specifications in @scheme[sandbox-path-permissions], and it uses
@defparam[sandbox-path-permissions perms
(listof (list/c (or/c 'execute 'write 'delete 'read 'exists)
(listof (list/c (or/c 'execute 'write 'delete 'read-bytecode 'read 'exists)
(or/c byte-regexp? bytes? string? path?)))]{
A parameter that configures the behavior of the default sandbox
@ -453,9 +453,9 @@ each is an access mode and a byte-regexp for paths that are granted this
access.
The access mode symbol is one of: @scheme['execute], @scheme['write],
@scheme['delete], @scheme['read], or @scheme['exists]. These symbols are
in decreasing order: each implies access for the following modes too
(e.g., @scheme['read] allows reading or checking for existence).
@scheme['delete], @scheme['read], or @scheme['exists]. These symbols
are in decreasing order: each implies access for the following modes
too (e.g., @scheme['read] allows reading or checking for existence).
The path regexp is used to identify paths that are granted access. It
can also be given as a path (or a string or a byte string), which is
@ -463,9 +463,25 @@ can also be given as a path (or a string or a byte string), which is
to a regexp that allows the path and sub-directories; e.g.,
@scheme["/foo/bar"] applies to @scheme["/foo/bar/baz"].
An additional mode symbol, @scheme['read-bytecode], is not part of the
linear order of these modes. Specifying this mode is similar to
specifying @scheme['read], but it is not implied by any other mode.
(For example, even if you specify @scheme['write] for a certain path,
you need to also specify @scheme['read-bytecode] to grant this
permission.) The sandbox usually works in the context of a lower code
inspector (see @scheme[sandbox-make-code-inspector]) which prevents
loading of untrusted bytecode files --- the sandbox is set-up to allow
loading bytecode from files that are specified with
@scheme['read-bytecode]. This specification is given by default to
the PLT collection hierarchy (including user-specific libraries) and
to libraries that are explicitly specified in an @scheme[#:allow-read]
argument. (Note that this applies for loading bytecode files only,
under a lower code inspector it is still impossible to use protected
module bindings (see @secref["modprotect"]).)
The default value is null, but when an evaluator is created, it is
augmented by @scheme['read] permissions that make it possible to use
collection libraries (including
augmented by @scheme['read-bytecode] permissions that make it possible
to use collection libraries (including
@scheme[sandbox-override-collection-paths]). See
@scheme[make-evalautor] for more information.}
@ -582,7 +598,11 @@ an evaluator, and the default parameter value is
A parameter that determines the procedure used to create the code
inspector for sandboxed evaluation. The procedure is called when
initializing an evaluator, and the default parameter value is
@scheme[make-inspector].}
@scheme[make-inspector]. The @scheme[current-load/use-compiled]
handler is setup to still allow loading of bytecode files under the
original code inspector when @scheme[sandbox-path-permissions] allows
it through a @scheme['read-bytecode] mode symbol, to make it possible
to load libraries.}
@defparam[sandbox-make-logger make (-> logger?)]{

145
collects/tests/mzscheme/sandbox.ss
View File

@ -275,59 +275,94 @@
;; limited FS access, allowed for requires
--top--
(let* ([tmp (find-system-path 'temp-dir)]
[schemelib (path->string (collection-path "scheme"))]
[list-lib (path->string (build-path schemelib "list.ss"))]
[test-lib (path->string (build-path tmp "sandbox-test.ss"))])
(t --top--
(set! ev (make-evaluator 'scheme/base))
--eval--
;; reading from collects is allowed
(list (directory-list ,schemelib))
(file-exists? ,list-lib) => #t
(input-port? (open-input-file ,list-lib)) => #t
;; writing is forbidden
(open-output-file ,list-lib) =err> "`write' access denied"
;; reading from other places is forbidden
(directory-list ,tmp) =err> "`read' access denied"
;; no network too
(require scheme/tcp)
(tcp-listen 12345) =err> "network access denied"
--top--
;; reading from a specified require is fine
(with-output-to-file test-lib
(lambda ()
(printf "~s\n" '(module sandbox-test scheme/base
(define x 123) (provide x))))
#:exists 'replace)
(set! ev (make-evaluator 'scheme/base #:requires `(,test-lib)))
--eval--
x => 123
(length (with-input-from-file ,test-lib read)) => 5
;; the directory is still not kosher
(directory-list ,tmp) =err> "`read' access denied"
--top--
;; should work also for module evaluators
;; --> NO! Shouldn't make user code require whatever it wants
;; (set! ev (make-evaluator `(module foo scheme/base
;; (require (file ,test-lib)))))
;; --eval--
;; x => 123
;; (length (with-input-from-file ,test-lib read)) => 5
;; ;; the directory is still not kosher
;; (directory-list tmp) =err> "file access denied"
--top--
;; explicitly allow access to tmp
(set! ev (parameterize ([sandbox-path-permissions
`((read ,tmp)
,@(sandbox-path-permissions))])
(make-evaluator 'scheme/base)))
--eval--
(length (with-input-from-file ,test-lib read)) => 5
(list? (directory-list ,tmp))
(open-output-file ,(build-path tmp "blah")) =err> "access denied"
(delete-directory ,(build-path tmp "blah")) =err> "access denied")
(delete-file test-lib))
(let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)]
[strpath (lambda xs (path->string (apply build-path xs)))]
[schemelib (strpath (collection-path "scheme"))]
[list-lib (strpath schemelib "list.ss")]
[list-zo (strpath schemelib "compiled" "list_ss.zo")]
[test-lib (strpath tmp "sandbox-test.ss")]
[test-zo (strpath tmp "compiled" "sandbox-test_ss.zo")]
[test2-lib (strpath tmp "sandbox-test2.ss")]
[test2-zo (strpath tmp "compiled" "sandbox-test2_ss.zo")])
(t --top--
(set! ev (make-evaluator 'scheme/base))
--eval--
;; reading from collects is allowed
(list? (directory-list ,schemelib))
(file-exists? ,list-lib) => #t
(input-port? (open-input-file ,list-lib)) => #t
;; writing is forbidden
(open-output-file ,list-lib) =err> "`write' access denied"
;; reading from other places is forbidden
(directory-list ,tmp) =err> "`read' access denied"
;; no network too
(require scheme/tcp)
(tcp-listen 12345) =err> "network access denied"
--top--
;; reading from a specified require is fine
(with-output-to-file test-lib
(lambda ()
(printf "~s\n" '(module sandbox-test scheme/base
(define x 123) (provide x)))))
(set! ev (make-evaluator 'scheme/base #:requires `(,test-lib)))
--eval--
x => 123
(length (with-input-from-file ,test-lib read)) => 5
;; the directory is still not kosher
(directory-list ,tmp) =err> "`read' access denied"
--top--
;; should work also for module evaluators
;; --> NO! Shouldn't make user code require whatever it wants
;; (set! ev (make-evaluator `(module foo scheme/base
;; (require (file ,test-lib)))))
;; --eval--
;; x => 123
;; (length (with-input-from-file ,test-lib read)) => 5
;; ;; the directory is still not kosher
;; (directory-list tmp) =err> "file access denied"
--top--
;; explicitly allow access to tmp, and write access to a single file
(make-directory (build-path tmp "compiled"))
(set! ev (parameterize ([sandbox-path-permissions
`((read ,tmp)
(write ,test-zo)
,@(sandbox-path-permissions))])
(make-evaluator 'scheme/base)))
--eval--
(length (with-input-from-file ,test-lib read)) => 5
(list? (directory-list ,tmp))
(open-output-file ,(build-path tmp "blah")) =err> "access denied"
(delete-directory ,(build-path tmp "blah")) =err> "access denied"
(list? (directory-list ,schemelib))
;; we can read/write/delete list-zo, but we can't load bytecode from
;; it due to the code inspector
(copy-file ,list-zo ,test-zo) => (void)
(copy-file ,test-zo ,list-zo) =err> "access denied"
(load/use-compiled ,test-lib) => (void)
(require 'list) =err> "access from an uncertified context"
(delete-file ,test-zo) => (void)
(delete-file ,test-lib) =err> "`delete' access denied"
--top--
;; a more explicit test of bytcode loading, allowing rw access to the
;; complete tmp directory, but read-bytecode only for test2-lib
(set! ev (parameterize ([sandbox-path-permissions
`((write ,tmp)
(read-bytecode ,test2-lib)
,@(sandbox-path-permissions))])
(make-evaluator 'scheme/base)))
--eval--
(define (cp from to)
(when (file-exists? to) (delete-file to))
(copy-file from to))
(cp ,list-lib ,test-lib) (cp ,list-zo ,test-zo)
(cp ,list-lib ,test2-lib) (cp ,list-zo ,test2-zo)
;; bytecode from test-lib is bad, even when we can read/write to it
(load/use-compiled ,test-zo)
(require 'list) =err> "access from an uncertified context"
;; bytecode from test2-lib is explicitly allowed
(load/use-compiled ,test2-lib)
(require 'list) => (void))
((dynamic-require 'scheme/file 'delete-directory/files) tmp))
;; languages and requires
--top--
@ -391,7 +426,9 @@
[sandbox-memory-limit 5]
[sandbox-eval-limits '(0.25 1/2)])
(make-evaluator 'scheme/base)))
;; GCing is needed to allow these to happen
;; GCing is needed to allow these to happen (note: the memory limit is very
;; tight here, this test usually fails if the sandbox library is not
;; compiled)
--eval-- (display (make-bytes 400000 65)) (collect-garbage)
--top-- (bytes-length (get-output ev)) => 400000
--eval-- (display (make-bytes 400000 65)) (collect-garbage)