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

some filename tweaks for windows

Browse Source 
svn: r5891
This commit is contained in:
Eli Barzilay 2007-04-08 21:39:12 +00:00
parent a2cbbb6371
commit 4cf75fbb65
2 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mzlib/sandbox.ss
View File

@ -509,8 +509,12 @@
[reqs (cond [(not requires) '()] [reqs (cond [(not requires) '()]
[(not (list? requires)) [(not (list? requires))
(error 'make-evaluator "bad requires: ~e" requires)] (error 'make-evaluator "bad requires: ~e" requires)]
[else (map (lambda (r) (if (pair? r) r `(file ,r))) [else
requires)])]) (map (lambda (r)
(if (or (pair? r) (symbol? r))
r
`(file ,(path->string (simplify-path* r)))))
requires)])])
(make-evaluator* (init-for-language lang) (make-evaluator* (init-for-language lang)
(require-perms lang reqs) (require-perms lang reqs)
(lambda () (build-program lang reqs input-program))))] (lambda () (build-program lang reqs input-program))))]

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

@ -165,7 +165,8 @@
(when (directory-exists? "/tmp") ; non-collects place to play with (when (directory-exists? "/tmp") ; non-collects place to play with
(let* ([mzlib (path->string (collection-path "mzlib"))] (let* ([mzlib (path->string (collection-path "mzlib"))]
[list-lib (path->string (build-path mzlib "list.ss"))] [list-lib (path->string (build-path mzlib "list.ss"))]
[test-lib "/tmp/sandbox-test.ss"]) [test-lib (path->string (path->complete-path ; <- for windows
"/tmp/sandbox-test.ss"))])
(t --top-- (t --top--
(set! ev (make-evaluator 'mzscheme '())) (set! ev (make-evaluator 'mzscheme '()))
--eval-- --eval--
@ -203,10 +204,15 @@
(directory-list "/tmp") =err> "file access denied" (directory-list "/tmp") =err> "file access denied"
--top-- --top--
;; explicitly allow access to /tmp ;; explicitly allow access to /tmp
(set! ev (parameterize ([sandbox-path-permissions (set! ev (let ([rx (if (eq? 'windows (system-type))
`((read #rx#"^/tmp(?:/|$)") ;; on windows this will have a drive letter
,@(sandbox-path-permissions))]) #rx#"^[a-zA-Z]:[/\\]tmp(?:[/\\]|$)"
(make-evaluator 'mzscheme '()))) #rx#"^/tmp(?:/|$)")])
(parameterize ([sandbox-path-permissions
;; allow all `/tmp' paths for windows
`((read ,rx)
,@(sandbox-path-permissions))])
(make-evaluator 'mzscheme '()))))
--eval-- --eval--
(length (with-input-from-file ,test-lib read)) => 5 (length (with-input-from-file ,test-lib read)) => 5
(list? (directory-list "/tmp")) (list? (directory-list "/tmp"))