path args to security guards can be #f

svn: r5821
This commit is contained in:
Eli Barzilay 2007-03-25 02:37:51 +00:00
parent 52a4b0f493
commit 7cdbe98749

View File

@ -94,19 +94,20 @@
(make-security-guard (make-security-guard
orig-security orig-security
(lambda (what path modes) (lambda (what path modes)
(let ([needed (let loop ([order permission-order]) (when path
(cond [(null? order) (let ([needed (let loop ([order permission-order])
(error 'default-sandbox-guard (cond [(null? order)
"unknown access modes: ~e" modes)] (error 'default-sandbox-guard
[(memq (car order) modes) (car order)] "unknown access modes: ~e" modes)]
[else (loop (cdr order))]))] [(memq (car order) modes) (car order)]
[bpath (parameterize ([current-security-guard orig-security]) [else (loop (cdr order))]))]
(path->bytes (simplify-path* path)))]) [bpath (parameterize ([current-security-guard orig-security])
(unless (ormap (lambda (perm) (path->bytes (simplify-path* path)))])
(and (perm<=? needed (car perm)) (unless (ormap (lambda (perm)
(path-ok? bpath (cadr perm)))) (and (perm<=? needed (car perm))
(sandbox-path-permissions)) (path-ok? bpath (cadr perm))))
(error what "file access denied ~a" (cons path modes))))) (sandbox-path-permissions))
(error what "file access denied ~a" (cons path modes))))))
(lambda (what . xs) (error what "network access denied: ~e" xs))))) (lambda (what . xs) (error what "network access denied: ~e" xs)))))
(define sandbox-security-guard (make-parameter default-sandbox-guard)) (define sandbox-security-guard (make-parameter default-sandbox-guard))