sort out for-require' vs. for-load' paths to a sandbox evaluator

The two became tangled in commit f7c16fc8, and then 952ae06105
adjusted the tangling in a way that broke code. This commit
further adjusts tangling in a way that hopefully causes fewer
compatibility problems, but it also splits inputs to
`make-evaluator' so that a programmer can choose more explicitly.

collects/racket/sandbox.rkt

@@ -210,12 +210,12 @@
 
 (define sandbox-make-logger (make-parameter current-logger))
 
-(define (compute-permissions paths+require-perms)
+(define (compute-permissions for-require for-load)
-  (define-values [paths require-perms]
+  ;; `for-require' is a list of module paths and paths that will be `reqiure'd,
-    (partition path-string? paths+require-perms))
+  ;; while `for-load' is a list of path (strings) that will be `load'ed.
-  (define cpaths (map path->complete-path paths))
+  (define cpaths (map path->complete-path for-load))
   (append (map (lambda (p) `(read ,(path->bytes p))) cpaths)
-          ;; when reading a file from "/foo/bar/baz.rkt" racket will try to see
+          ;; when loading a module from "/foo/bar/baz.rkt" racket will try to see
           ;; if "/foo/bar" exists, so allow these paths too; it might be needed
           ;; to allow 'exists on any parent path, but I'm not sure that this is
           ;; safe in terms of security, so put just the immediate parent dir in
@@ -223,7 +223,7 @@
                         (let ([p (and (file-exists? p) (path-only p))])
                           (and p `(exists ,(path->bytes p)))))
                       cpaths)
-          (module-specs->path-permissions require-perms)))
+          (module-specs->path-permissions for-require)))
 
 ;; computes permissions that are needed for require specs (`read-bytecode' for
 ;; all files and "compiled" subdirs, `exists' for the base-dir)
@@ -253,6 +253,8 @@
     (cond [(and (pair? mod) (eq? 'lib (car mod))) #f]
           [(module-path? mod)
            (simplify-path* (resolve-module-path mod #f))]
+          [(path? mod)
+           (simplify-path* mod)]
           [(not (and (pair? mod) (pair? (cdr mod))))
            ;; don't know what this is, leave as is
            #f]
@@ -660,7 +662,7 @@
    (current-continuation-marks)
    reason))
 
-(define (make-evaluator* who init-hook allow program-maker)
+(define (make-evaluator* who init-hook allow-for-require allow-for-load program-maker)
   (define orig-code-inspector (current-code-inspector))
   (define orig-security-guard (current-security-guard))
   (define orig-cust     (current-custodian))
@@ -891,7 +893,7 @@
        (exists ,(find-system-path 'addon-dir))
        (read ,(find-system-path 'links-file))
        (read ,(find-lib-dir))
-       ,@(compute-permissions allow)
+       ,@(compute-permissions allow-for-require allow-for-load)
        ,@(sandbox-path-permissions))]
     ;; restrict the sandbox context from this point
     [current-security-guard
@@ -960,32 +962,78 @@
     ;; program didn't execute
     (raise r)))
 
+(define (check-and-combine-allows who allow allow-for-require allow-for-load)
+  (define (check-arg-list arg what ok?)
+    (unless (and (list? arg) (andmap ok? arg))
+      (error who "bad ~a: ~e" what arg)))
+  (check-arg-list allow "allows"
+                  (lambda (x) (or (path? x) (module-path? x) (path-string? x))))
+  (check-arg-list allow-for-require "allow-for-requires"
+                  (lambda (x) (or (path? x) (module-path? x))))
+  (check-arg-list allow-for-load "allow-for-loads" path-string?)
+  ;; This split of `allow' is ugly but backward-compatible:
+  (define-values (more-allow-for-load more-allow-for-require)
+    (partition (lambda (p) (or (path? p) 
+                               ;; strings that can be treated as paths:
+                               (not (module-path? p)))) 
+               allow))
+  (values (append allow-for-require
+                  more-allow-for-require)
+          (append allow-for-load
+                  more-allow-for-load)))
+
 (define (make-evaluator lang
-                        #:requires [requires null] #:allow-read [allow null]
+                        #:requires [requires null] 
+                        #:allow-read [allow null]
+                        #:allow-for-require [allow-for-require null]
+                        #:allow-for-load [allow-for-load null]
                         . input-program)
   ;; `input-program' is either a single argument specifying a file/string, or
   ;;  multiple arguments for a sequence of expressions
-  ;; make it possible to use simple paths to files to require
+  (define all-requires
-  (define reqs (if (not (list? requires))
+    (extract-required (or (decode-language lang) lang) 
-                 (error 'make-evaluator "bad requires: ~e" requires)
+                      requires))
-                 (map (lambda (r)
+  (unless (and (list? requires) 
-                        (if (or (pair? r) (symbol? r))
+               (andmap (lambda (x) (or (path-string? x) 
-                          r
+                                       (module-path? x)
-                          `(file ,(path->string (simplify-path* r)))))
+                                       (and (list? x)
-                      requires)))
+                                            (pair? x)
+                                            (eq? (car x) 'for-syntax)
+                                            (andmap module-path? (cdr x)))))
+                       requires))
+    (error 'make-evaluator "bad requires: ~e" requires))
+  (define-values (all-for-require all-for-load)
+    (check-and-combine-allows 'make-evaluator allow allow-for-require allow-for-load))
+  (define (normalize-require-for-syntax r)
+    (if (or (path? r) (and (string? r) 
+                           (not (module-path? r))))
+        `(file ,(path->string (simplify-path* r)))
+        r))
+  (define (normalize-require-for-allow r)
+    (cond
+     [(and (string? r) (not (module-path? r))) (list (string->path r))]
+     [(and (pair? r) (eq? (car r) 'for-syntax))
+      (cdr r)]
+     [else (list r)]))
   (make-evaluator* 'make-evaluator
                    (init-hook-for-language lang)
-                   (append (extract-required (or (decode-language lang) lang)
+                   (append (apply append
-                                             reqs)
+                                  (map normalize-require-for-allow all-requires))
-                           (if (and (= 1 (length input-program))
+                           all-for-require)
+                   (append (if (and (= 1 (length input-program))
                                     (path? (car input-program)))
                                (list (car input-program))
                                '())
-                           allow)
+                           all-for-load)
-                   (lambda () (build-program lang reqs input-program))))
+                   (lambda () (build-program lang 
+                                             (map normalize-require-for-syntax all-requires)
+                                             input-program))))
 
-(define (make-module-evaluator
+(define (make-module-evaluator input-program 
-         input-program #:allow-read [allow null] #:language [reqlang #f])
+                               #:allow-read [allow null] 
+                               #:allow-for-require [allow-for-require null]
+                               #:allow-for-load [allow-for-load null]
+                               #:language [reqlang #f])
   ;; this is for a complete module input program
   (define (make-program)
     (define-values [prog source]
@@ -1005,7 +1053,10 @@
       [_else (error 'make-module-evaluator
                     "expecting a `module' program; got ~.s"
                     (syntax->datum (car prog)))]))
+  (define-values (all-for-require all-for-load)
+    (check-and-combine-allows 'make-module-evaluator allow allow-for-require allow-for-load))
   (make-evaluator* 'make-module-evaluator
                    void
-                   (if (path? input-program) (cons input-program allow) allow)
+                   all-for-require
+                   (if (path? input-program) (cons input-program all-for-load) all-for-load)
                    make-program))

collects/scribblings/reference/sandbox.scrbl

@@ -23,12 +23,19 @@ for the common use case where sandboxes are very limited.
                                             (list/c 'special symbol?)
                                             (cons/c 'begin list?))]
                             [input-program any/c] ...
-                            [#:requires requires (listof (or/c module-path? path?))]
+                            [#:requires requires 
-                            [#:allow-read allow (listof (or/c module-path? path?))])
+                                        (listof (or/c module-path? path-string? 
+                                                      (cons/c 'for-syntax (listof module-path?))))
+                                        null]
+                            [#:allow-for-require allow-for-require (listof (or/c module-path? path?)) null]
+                            [#:allow-for-load allow-for-load (listof path-string?) null]
+                            [#:allow-read allow-read (listof (or/c module-path? path-string?)) null])
             (any/c . -> . any)]
-           [(make-module-evaluator [module-decl (or/c syntax? pair?)]
+           [(make-module-evaluator [module-decl (or/c syntax? pair? path? input-port? string? bytes?)]
-                                   [#:language   lang  (or/c #f module-path?)]
+                                   [#:language   lang  (or/c #f module-path?) #f]
-                                   [#:allow-read allow (listof (or/c module-path? path?))])
+                                   [#:allow-for-require allow-for-require (listof (or/c module-path? path?)) null]
+                                   [#:allow-for-load allow-for-load (listof path-string?) null]
+                                   [#:allow-read allow-read (listof (or/c module-path? path-string?)) null])
             (any/c . -> . any)])]{
 
 The @racket[make-evaluator] function creates an evaluator with a
@@ -39,12 +46,16 @@ works in the context of a given module. The result in either case is a
 function for further evaluation.
 
 The returned evaluator operates in an isolated and limited
-environment.  In particular, filesystem access is restricted.  The
+environment. In particular, filesystem access is restricted, which may
-@racket[allow] argument extends the set of files that are readable by
+interfere with using modules from the filesystem.  See below for
-the evaluator to include the specified modules and their imports
+information on the @racket[allow-for-require],
-(transitively). When @racket[language] is a module path and when
+@racket[allow-for-load], and @racket[allow-read] arguments.  When
-@racket[requires] is provided, the indicated modules are implicitly
+@racket[language] is a module path or when @racket[requires] is
-included in the @racket[allow] list.
+provided, the indicated modules are implicitly included in the
+@racket[allow-for-require] list. (For backward compatibility,
+non-@racket[module-path?] path strings are allowed in
+@racket[requires]; they are implicitly converted to paths before
+addition to @racket[allow-for-require].)
 
 Each @racket[input-program] or @racket[module-decl] argument provides
 a program in one of the following forms:
@@ -157,7 +168,8 @@ module, and all imports are part of the program.  In some cases it is
 useful to restrict the program to be a module using a spcific module
 in its language position --- use the optional @racket[lang] argument
 to specify such a restriction (the default, @racket[#f], means no
-restriction is enforced).
+restriction is enforced). When the program is specified as a path, then
+the path is implicitly added to the @racket[allow-for-load] list.
 
 @racketblock[
 (define base-module-eval2
@@ -167,8 +179,8 @@ restriction is enforced).
                             (define later 5))))
 ]
 
-@racket[make-module-evaluator] can be very convenient for testing
+The @racket[make-module-evaluator] function can be convenient for testing
-module files: all you need to do is pass in a path value for the file
+module files: pass in a path value for the file
 name, and you get back an evaluator in the module's context which you
 can use with your favorite test facility.
 
@@ -193,6 +205,18 @@ environment too --- so, for example, if the memory that is required to
 create the sandbox is higher than the limit, then
 @racket[make-evaluator] will fail with a memory limit exception.
 
+The @racket[allow-for-require] and @racket[allow-for-load] arguments
+adjust filesystem permissions to extend the set of files that
+are usable by the evaluator. The @racket[allow-for-require] argument lists
+modules that can be @racket[require]d along with their imports
+(transitively). The @racket[allow-for-load] argument lists files that can
+be @racket[load]ed. (The precise permissions needed for
+@racket[require] versus @racket[load] can differ.)  The
+@racket[allow-read] argument is for backward compatibility, only; each
+@racket[module-path?] element of @racket[allow-read] is effectively
+moved to @racket[allow-for-require], while other elements are moved to
+@racket[all-for-load].
+
 The sandboxed evironment is well isolated, and the evaluator function
 essentially sends it an expression and waits for a result.  This form
 of communication makes it impossible to have nested (or concurrent)

collects/tests/racket/sandbox.rktl

@@ -36,14 +36,14 @@
   (test 'shut (lambda () (nested* (shut)))))
 
 (let ([ev void])
-  (define (make-evaluator! . args)
+  (define (make-evaluator! #:requires [reqs null] . args)
-    (set! ev (apply make-evaluator args)))
+    (set! ev (apply make-evaluator args #:requires reqs)))
   (define (make-base-evaluator! . args)
     (set! ev (apply make-evaluator 'racket/base args)))
   (define (make-base-evaluator/reqs! reqs . args)
     (set! ev (apply make-evaluator 'racket/base #:requires reqs args)))
-  (define (make-module-evaluator! . args)
+  (define (make-module-evaluator! #:allow-read [allow null] . args)
-    (set! ev (apply make-module-evaluator args)))
+    (set! ev (apply make-module-evaluator args #:allow-read allow)))
   (define (run thunk)
     (with-handlers ([void (lambda (e) (list 'exn: e))])
       (call-with-values thunk (lambda vs (cons 'vals: vs)))))
@@ -281,6 +281,13 @@
    x => 1
    (define x 2) =err> "cannot re-define a constant"
 
+   ;; `for-syntax' is allowed in #:requires:
+   --top--
+   (make-evaluator! 'scheme/base #:requires '((for-syntax racket/base)))
+   --eval--
+   (define-syntax (m stx) #'10)
+   m => 10
+
    ;; limited FS access, allowed for requires
    --top--
    (let* ([tmp       (make-temporary-file "sandboxtest~a" 'directory)]
@@ -291,7 +298,23 @@
           [test-lib  (strpath tmp "sandbox-test.rkt")]
           [test-zo   (strpath tmp "compiled" "sandbox-test_rkt.zo")]
           [test2-lib (strpath tmp "sandbox-test2.rkt")]
-          [test2-zo  (strpath tmp "compiled" "sandbox-test2_rkt.zo")])
+          [test2-zo  (strpath tmp "compiled" "sandbox-test2_rkt.zo")]
+          [test3-file "sandbox-test3.rkt"]
+          [test3-lib  (strpath tmp test3-file)]
+          [make-module-evaluator/rel (lambda (mod
+                                              #:allow-read [allow null] 
+                                              #:allow-for-require [allow-for-require null] 
+                                              #:allow-for-load [allow-for-load null])
+                                       (parameterize ([current-directory tmp]
+                                                      [current-load-relative-directory tmp])
+                                         (make-module-evaluator mod
+                                                                #:allow-read allow
+                                                                #:allow-for-require allow-for-require
+                                                                #:allow-for-load allow-for-load)))]
+          [make-evaluator/rel (lambda (lang)
+                                (parameterize ([current-directory tmp]
+                                               [current-load-relative-directory tmp])
+                                  (make-evaluator lang)))])
      (t --top--
         (make-base-evaluator!)
         --eval--
@@ -320,6 +343,47 @@
         ;; the directory is still not kosher
         (directory-list ,tmp) =err> "`read' access denied"
         --top--
+        ;; ports, strings, and bytes are also allowed, but in the case
+        ;; of ports, we have to specificaly enable access to the
+        ;; enclosing directory, since the port name connects it to the
+        ;; directory, and some part of the module infrastructure exploits that:
+        (make-module-evaluator!
+         (open-input-file (string->path test-lib))) =err> "`exists' access denied"
+        (make-module-evaluator! (open-input-file (string->path test-lib))
+                                ;; allowing a file read indirectly allows containing-directory
+                                ;; existence check:
+                                #:allow-read (list (string->path test-lib)))
+        (make-module-evaluator! (file->string (string->path test-lib)))
+        (make-module-evaluator! (file->bytes (string->path test-lib)))
+        --top--
+        ;; a relative-path string should work as a module to be `require'd,
+        ;; as opposed to a module to be `load'ed:
+        (with-output-to-file test3-lib
+          (lambda ()
+            (printf "~s\n" '(module sandbox-test racket/base
+                              (provide #%module-begin)))))
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-read (list test3-file))
+        ;; for-require is more clear:
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-for-require (list test3-file))
+        ;; for-load isn't ok:
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-for-load (list test3-file))
+        =err> "`read' access denied"
+        ;; an absolute path is treated like `for-load':
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-read (list test3-lib))
+        =err> "`read' access denied"
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-read (list (string->path test3-lib)))
+        =err> "`read' access denied"
+        ;; an absolute path with `for-require' is ok:
+        (make-module-evaluator/rel `(module m ,test3-file)
+                                   #:allow-for-require (list (string->path test3-lib)))
+        ;; make sure that the language is treated as a require:
+        (make-evaluator/rel test3-file)
+        --top--
         ;; require it
         (make-base-evaluator/reqs! `(,test-lib))
         --eval--