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

use proper tmp directory, remove temp file

Browse Source 
svn: r10254
This commit is contained in:
Eli Barzilay 2008-06-13 17:06:05 +00:00
parent 4baccff55a
commit 87bb5ee526
1 changed files with 16 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -226,11 +226,10 @@
;; limited FS access, allowed for requires ;; limited FS access, allowed for requires
--top-- --top--
(when (directory-exists? "/tmp") ; non-collects place to play with (let* ([tmp (find-system-path 'temp-dir)]
(let* ([mzlib (path->string (collection-path "mzlib"))] [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 (path->string (path->complete-path ; <- for windows [test-lib (path->string (build-path tmp "sandbox-test.ss"))])
"/tmp/sandbox-test.ss"))])
(t --top-- (t --top--
(set! ev (make-evaluator 'mzscheme '())) (set! ev (make-evaluator 'mzscheme '()))
--eval-- --eval--
@ -241,7 +240,7 @@
;; writing is forbidden ;; writing is forbidden
(open-output-file ,list-lib) =err> "file access denied" (open-output-file ,list-lib) =err> "file access denied"
;; reading from other places is forbidden ;; reading from other places is forbidden
(directory-list "/tmp") =err> "file access denied" (directory-list ,tmp) =err> "file access denied"
;; no network too ;; no network too
(tcp-listen 12345) =err> "network access denied" (tcp-listen 12345) =err> "network access denied"
--top-- --top--
@ -256,7 +255,7 @@
x => 123 x => 123
(length (with-input-from-file ,test-lib read)) => 5 (length (with-input-from-file ,test-lib read)) => 5
;; the directory is still not kosher ;; the directory is still not kosher
(directory-list "/tmp") =err> "file access denied" (directory-list ,tmp) =err> "file access denied"
--top-- --top--
;; should work also for module evaluators ;; should work also for module evaluators
;; --> NO! Shouldn't make user code require whatever it wants ;; --> NO! Shouldn't make user code require whatever it wants
@ -266,24 +265,19 @@
;; x => 123 ;; x => 123
;; (length (with-input-from-file ,test-lib read)) => 5 ;; (length (with-input-from-file ,test-lib read)) => 5
;; ;; the directory is still not kosher ;; ;; the directory is still not kosher
;; (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 (let ([rx (if (eq? 'windows (system-type)) (set! ev (parameterize ([sandbox-path-permissions
;; on windows this will have a drive letter `((read ,tmp)
#rx#"^[a-zA-Z]:[/\\]tmp(?:[/\\]|$)"
#rx#"^/tmp(?:/|$)")])
(parameterize ([sandbox-path-permissions
;; allow all `/tmp' paths for windows
`((read ,rx)
,@(sandbox-path-permissions))]) ,@(sandbox-path-permissions))])
(make-evaluator 'mzscheme '())))) (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))
(open-output-file "/tmp/blah") =err> "file access denied" (open-output-file ,(build-path tmp "blah")) =err> "access denied"
(delete-directory "/tmp/blah") =err> "file access denied" (delete-directory ,(build-path tmp "blah")) =err> "access denied")
))) (delete-file test-lib))
;; languages and requires ;; languages and requires
--top-- --top--