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

* sandbox-security-guard can now be a function that translates a given

Browse Source 
security guard to a new one
* this is now used for the default to avoid grabbing the global
  security guard

svn: r12828
This commit is contained in:
Eli Barzilay 2008-12-13 14:11:28 +00:00
parent f1dc6c831c
commit e2221c800b
2 changed files with 49 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/scheme/sandbox.ss
View File

@ -2,6 +2,7 @@
(require scheme/port
scheme/list
scheme/string
syntax/moddep
scheme/gui/dynamic)
@ -17,8 +18,8 @@
sandbox-override-collection-paths
sandbox-path-permissions
sandbox-security-guard
sandbox-exit-handler
sandbox-network-guard
sandbox-exit-handler
sandbox-make-inspector
sandbox-make-logger
sandbox-memory-limit
@ -117,31 +118,37 @@
(make-parameter (lambda (what . xs)
(error what "network access denied: ~e" xs))))
(define default-sandbox-guard
(let ([orig-security (current-security-guard)])
(make-security-guard
orig-security
(lambda (what path modes)
(when path
(let ([needed (let loop ([order permission-order])
(cond [(null? order)
(error 'default-sandbox-guard
"unknown access modes: ~e" modes)]
[(memq (car order) modes) (car order)]
[else (loop (cdr order))]))]
[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))
(error what "`~a' access denied for ~a"
(apply string-append
(add-between (map symbol->string modes) "+"))
path)))))
(lambda args (apply (sandbox-network-guard) args)))))
(define (make-default-sandbox-guard orig-security)
(make-security-guard
orig-security
(lambda (what path modes)
(when path
(let ([needed (let loop ([order permission-order])
(cond [(null? order)
(error 'default-sandbox-guard
"unknown access modes: ~e" modes)]
[(memq (car order) modes) (car order)]
[else (loop (cdr order))]))]
[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))
(error what "`~a' access denied for ~a"
(string-append* (add-between (map symbol->string modes) "+"))
path)))))
(lambda args (apply (sandbox-network-guard) args))))
(define sandbox-security-guard (make-parameter default-sandbox-guard))
(define sandbox-security-guard
(make-parameter make-default-sandbox-guard
(lambda (x)
(if (or (security-guard? x)
(and (procedure? x) (procedure-arity-includes? x 1)))
x
(raise-type-error
'sandbox-security-guard
"security-guard or a security-guard translator procedure" x)))))
(define (default-sandbox-exit-handler _)
(error 'exit "sandboxed code cannot exit"))
@ -660,7 +667,9 @@
;; general info
[current-command-line-arguments '#()]
;; restrict the sandbox context from this point
[current-security-guard (sandbox-security-guard)]
[current-security-guard
(let ([g (sandbox-security-guard)])
(if (security-guard? g) g (g (current-security-guard))))]
[exit-handler (sandbox-exit-handler)]
[current-inspector ((sandbox-make-inspector))]
[current-logger ((sandbox-make-logger))]

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

@ -414,13 +414,16 @@ done using a fake library that provides the same interface but no
actual interaction. The default is @scheme[null].}
@defparam[sandbox-security-guard guard security-guard?]{
@defparam[sandbox-security-guard guard
(or/c security-guard? (security-guard? . -> . security-guard?))]{
A parameter that determines the initial
@scheme[(current-security-guard)] for sandboxed evaluations. The
default forbids all filesystem I/O except for things in
@scheme[sandbox-path-permissions], and it uses
@scheme[sandbox-network-guard] for network connections.}
@scheme[(current-security-guard)] for sandboxed evaluations. It can
be either a security guard, or a function that constructs a security
guard from a given one. The default is a function that restricts the
access of the current security guard by forbidding all filesystem I/O
except for specifications in @scheme[sandbox-path-permissions], and it
uses @scheme[sandbox-network-guard] for network connections.}
@defparam[sandbox-path-permissions perms
@ -451,12 +454,6 @@ collection libraries (including
@scheme[make-evalautor] for more information.}
@defparam[sandbox-exit-handler handler (any/c . -> . any)]{
A parameter that determines the initial @scheme[(exit-handler)] for
sandboxed evaluations. The default handler simply throws an error.}
@defparam[sandbox-network-guard proc
(symbol?
(or/c (and/c string? immutable?) #f)
@ -469,6 +466,12 @@ default @scheme[sandbox-security-guard]. The default forbids all
network connection.}
@defparam[sandbox-exit-handler handler (any/c . -> . any)]{
A parameter that determines the initial @scheme[(exit-handler)] for
sandboxed evaluations. The default handler simply throws an error.}
@defparam[sandbox-memory-limit limit (or/c exact-nonnegative-integer? #f)]{
A parameter that determines the total memory limit on the sandbox.