* Added `sandbox-override-collection-paths' to allow a local library overrides

* Added a `overridden-collects' direectory 
* Forbid `exit' from use code
* Note about stderr not being redirected

svn: r5439

collects/handin-server/doc.txt

@@ -635,6 +635,15 @@ by this function.
   `read-case-sensitive' to `#t', and `read-decimal-as-inexact' to `#f'
   (both are sensible choices for testing code).
 
+> sandbox-override-collection-paths
+  A parameter that holds a list of collection directories.  A
+  submission evaluator that is created by `make-evaluator' will put
+  these directories (ones tat actually exist) in front of the
+  collections in `current-library-collection-paths' -- so you can put
+  collection overrides there.  The default is an `overridden-collects'
+  directory in the handin-server collection, which comes with a few
+  common overrides for teachpacks that use the GUI.
+
 > sandbox-security-guard
   A parameter that holds a security guard that is used by all
   evaluations that happen in a `make-evaluator' function.  The default
@@ -676,6 +685,7 @@ by this function.
   * the symbol 'string, similar to the above, but uses a string;
   * the symbol 'pipe, which will make it use a pipe for output, and
     `get-output' returns the input end of the pipe.
+  (Note that error output is *not* redirected.)
 
 > (get-output evaluator)
   When this is used with an evaluator that was created with

collects/handin-server/overridden-collects/readme.txt

@@ -0,0 +1,6 @@
+This directory is used (by default) as a first root for searching
+collections when evaluating user code.  This means that PLT libraries
+that appear here will be used instead of ones in the PLT tree or the
+user-local collections.  Use it to override collections that are safe
+for testing, for example -- avoid using actual gui.  See also the
+documentation for `sandbox-override-collection-paths' in "doc.txt".

collects/handin-server/sandbox.ss

@@ -6,6 +6,7 @@
            coverage-enabled
            namespace-specs
            sandbox-reader
+           sandbox-override-collection-paths
            sandbox-security-guard
            sandbox-path-permissions
            sandbox-input
@@ -48,6 +49,10 @@
 
   (define sandbox-reader (make-parameter default-sandbox-reader))
 
+  (define sandbox-override-collection-paths
+    (make-parameter (list (build-path (collection-path "handin-server")
+                                      "overridden-collects"))))
+
   ;; Security Guard -----------------------------------------------------------
 
   (define sep (bytes-ref (path->bytes (simplify-path "/")) 0)) ; '\' on windows
@@ -69,13 +74,13 @@
                                      (path->bytes (simplify-path* path))
                                      (bytes-append #"(?:$|" sep-re #")"))))))
 
-  (define lib-permissions
+  (define (get-lib-permissions libs)
     (let* ([sep-re   (regexp-quote (bytes sep))]
            [last-sep (byte-regexp (bytes-append sep-re #"?$"))])
-      (map (lambda (p) (list 'read (dir-path->bytes-re p)))
+      (map (lambda (p) (list 'read (dir-path->bytes-re p))) libs)))
-           (current-library-collection-paths))))
 
-  (define sandbox-path-permissions (make-parameter lib-permissions))
+  (define sandbox-path-permissions
+    (make-parameter (get-lib-permissions (current-library-collection-paths))))
 
   (define (path-ok? bpath ok)
     (cond [(bytes? ok) (equal? bpath ok)]
@@ -286,6 +291,11 @@
       (parameterize
           ([current-namespace (make-evaluation-namespace)]
            [current-inspector (make-inspector)]
+           [current-library-collection-paths
+            (filter directory-exists?
+                    (append (sandbox-override-collection-paths)
+                            (current-library-collection-paths)))]
+           [exit-handler (lambda x (error 'exit "user code cannot exit"))]
            [current-input-port
             (let ([inp (sandbox-input)]) (if inp (input->port inp) null-input))]
            [current-output-port
@@ -308,8 +318,10 @@
                                           (get-output-bytes o1))))
                          o))]
                     [else (error 'make-evaluator "bad output: ~e" out)]))]
-           [sandbox-path-permissions (append (require-perms language teachpacks)
+           [sandbox-path-permissions
-                                             (sandbox-path-permissions))]
+            (append (sandbox-path-permissions)
+                    (get-lib-permissions (sandbox-override-collection-paths))
+                    (require-perms language teachpacks))]
            [current-security-guard (sandbox-security-guard)])
         ;; Note the above definition of `current-eventspace': in MzScheme, it
         ;; is a parameter that is not used at all.  Also note that creating an