From 29a401b6922599f98a4672cba81df2162e684679 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 14 May 2012 09:35:06 -0600
Subject: [PATCH] racket/sandbox: treat linked collections like others

---
 collects/racket/sandbox.rkt    | 10 ++++++++--
 collects/tests/racket/link.rkt | 20 +++++++++++++++++++-
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/collects/racket/sandbox.rkt b/collects/racket/sandbox.rkt
index 3bc3e80da1..f9d717f336 100644
--- a/collects/racket/sandbox.rkt
+++ b/collects/racket/sandbox.rkt
@@ -7,7 +7,8 @@
          syntax/moddep
          racket/gui/dynamic
          planet/config
-         setup/dirs)
+         setup/dirs
+         setup/link)
 
 (provide gui?
          sandbox-gui-available
@@ -897,7 +898,12 @@
                      (current-library-collection-paths)))]
     [sandbox-path-permissions
      `(,@(map (lambda (p) `(read-bytecode ,p))
-              (current-library-collection-paths))
+              (append
+               (current-library-collection-paths)
+               (links #:root? #t #:user? #f)
+               (links #:root? #t #:user? #t)
+               (map cdr (links #:user? #f #:with-path? #t))
+               (map cdr (links #:user? #t #:with-path? #t))))
        (read-bytecode ,(PLANET-BASE-DIR))
        (exists ,(find-system-path 'addon-dir))
        (read ,(find-system-path 'links-file))
diff --git a/collects/tests/racket/link.rkt b/collects/tests/racket/link.rkt
index 8903be620f..b0cc35d2f5 100644
--- a/collects/tests/racket/link.rkt
+++ b/collects/tests/racket/link.rkt
@@ -1,6 +1,7 @@
 #lang racket
 (require setup/link
-         compiler/find-exe)
+         compiler/find-exe
+         racket/sandbox)
 
 (define-syntax-rule (test expect expr)
   (do-test expect expr 'expr))
@@ -223,6 +224,23 @@
 (run-setup "c1/s2")
 (test #t (file-exists? (build-path c1/s2-dir "compiled" "n2_rkt.zo")))
 
+;; ----------------------------------------
+;; sandbox:
+
+(test-racket "#f" '("-l" "racket/base" "-l" "racket/sandbox" "-e" "(void? (make-evaluator 'racket/base))"))
+(test-racket "'mz1" '("-l" "racket/base" "-l" "racket/sandbox" 
+                      "-e" "(sandbox-output current-output-port)"
+                      "-e" "(define e (make-evaluator 'racket/base))" 
+                      "-e" "(e '(require mzlib/m1))"))
+(test-racket "'m2" '("-l" "racket/base" "-l" "racket/sandbox" 
+                     "-e" "(sandbox-output current-output-port)"
+                     "-e" "(define e (make-evaluator 'racket/base))" 
+                     "-e" "(e '(require c1/m2))"))
+(test-racket "'n1" '("-l" "racket/base" "-l" "racket/sandbox" 
+                     "-e" "(sandbox-output current-output-port)"
+                     "-e" "(define e (make-evaluator 'racket/base))" 
+                     "-e" "(e '(require c1/s1/n1))"))
+
 ;; ----------------------------------------
 ;; docs in a linked collection: