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

typo in the last commit

Browse Source 
svn: r12832
This commit is contained in:
Eli Barzilay 2008-12-13 17:18:40 +00:00
parent 46e16fc206
commit bd01cda595
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/scheme/sandbox.ss
View File

@ -119,27 +119,28 @@
(make-parameter (lambda (what . xs)
(error what "network access denied: ~e" xs))))
(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 (make-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"
(string-append* (add-between (map symbol->string modes) "+"))
path)))))
(lambda args (apply (sandbox-network-guard) args)))))
(define sandbox-security-guard
(make-parameter make-default-sandbox-guard