From 812997204f8fd2257faabd51a2a9f42ac2ed1284 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Fri, 12 Jan 2007 07:40:24 +0000
Subject: [PATCH] * Main change: added `active-dirs' and `inactive-dirs' as
 configuration options   instead of moving directories. * Don't show solutions
 in active assignments, also check that when downloading   files. * Improved
 (no `suffix:') error messages for errors that users should   eventually see.

svn: r5331
---
 collects/handin-server/doc.txt                | 176 ++++++++++--------
 collects/handin-server/extra-utils.ss         |  19 +-
 collects/handin-server/handin-server.ss       | 149 +++++++--------
 collects/handin-server/private/config.ss      |  27 ++-
 .../status-web-root/servlets/status.ss        | 100 +++++-----
 5 files changed, 244 insertions(+), 227 deletions(-)

diff --git a/collects/handin-server/doc.txt b/collects/handin-server/doc.txt
index d6ba5bdf4e..8abcd6f2fc 100644
--- a/collects/handin-server/doc.txt
+++ b/collects/handin-server/doc.txt
@@ -51,9 +51,10 @@ Quick Start for a Test Drive:
                  "Chester Tester"
                  "123")))
 
- 5.  Make an "active" subdirectory in your new directory.
+ 5.  Make an "test" subdirectory in your new directory.
 
- 6.  Make a "test" subdirectory in "active".
+ 6.  Create a file "config.ss" with the following content:
+       ((active-dirs ("test")))
 
  7.  In your new directory, run
         mred -mvqM handin-server
@@ -65,7 +66,7 @@ Quick Start for a Test Drive:
  9.  Start DrScheme, click "Handin" to run the client, submit with
      username "tester" and password "pw".
 
-     The submitted file will be .../active/test/tester/handin.scm.
+     The submitted file will be .../test/tester/handin.scm.
 
  10. Check the status of your submission by pointing a web browser at
         https://localhost:7980/servlets/status.ss
@@ -164,13 +165,22 @@ sub-directories:
     students with the handin client, "private-key.pem" is kept
     private.
 
-  * "config.ss" (optional) --- configuration options.  The file format
-    is
+  * "config.ss" --- configuration options.  The file format is
 
          ((<key> <val>) ...)
 
     The following keys can be used (without the preceding quote):
 
+      'active-dirs : a list of directories that are active
+         submissions, relative to the current directory or absolute;
+         the last path element for each of these (and 'inactive-dirs
+         below) should be unique, and is used to identify the
+         submission (for example, in the client's submission dialog
+         and in the status servlet)
+
+      'inactive-dirs : a list of inactive submission directories (see
+         above for details)
+
       'port-number : the port for the main handin server; the default
          is 7979
 
@@ -299,7 +309,8 @@ sub-directories:
     don't save a copy that has inconsistent options: it is best to
     create a new configuration file and move it over the old one, or
     use an editor that does so and not save until the new contents is
-    ready.)
+    ready.)  This is most useful for closing & openning submission
+    directories.
 
   * "users.ss" (created if not present if a user is added) --- keeps
     the list of user accounts, along with the associated password
@@ -362,67 +373,81 @@ sub-directories:
     'plaintext symbol, which will be used without encryption.  This
     may be useful for manually resetting a forgotten passwords.
 
-  * "active/" --- sub-directory for active assignments. A list of
-    active assignments is sent to a client tool when a student clicks
-    "Handin", based on the contents of this directory. The student
-    then selects from the list.  The assignments are ordered in the
-    student's menu using `string<?', and the first assignment is the
-    default selection.
+  * "log" (or any other name that the 'log-file configuration option
+    specifies (if any), created if not present, appended otherwise)
+    --- records connections and actions, where each entry is of the
+    form
+        (id time-str msg-str)
+        [<id>|<time>] <msg>
+    where `<id>' is an integer representing the connection (numbered
+    consecutively from 1 when the server starts), "-" for a message
+    without a connection, and "wN" for a message from the status
+    servlet.
 
-    Within each directory, the student id is used for a sub-directory
-    name. Within each student sub-directory are directories for handin
-    attempts and successes. If a directory "ATTEMPT" exists, it
-    contains the most recent (unsuccessful) handin attempt.
-    Directories "SUCCESS-n" (where n counts from 0) contain successful
-    handins; the lowest numbered such directory represents the latest
-    handin.
+  * Active and inactive assignment directories (which you can put in a
+    nested directory for convenience, or specify a different absolute
+    directory), as specified by the configuration file using the
+    `active-dirs' and `inactive-dirs'.  A list of active assignment
+    directories (the last path element in each specified path is used
+    as a label) is sent to the client tool when a student clicks
+    "Handin".  The assignment labels are ordered in the student's menu
+    using `string<?', and the first assignment is the default
+    selection.
 
-    A cleanup process in the server copies successful submission to
+    Within each assignment directory, the student id is used for a
+    sub-directory name.  Within each student sub-directory are
+    directories for handin attempts and successes.  If a directory
+    "ATTEMPT" exists, it contains the most recent (unsuccessful or
+    currently-in-submission) handin attempt.  Directories "SUCCESS-n"
+    (where n counts from 0) contain successful handins; the lowest
+    numbered such directory represents the latest handin.
+
+    A cleanup process in the server copies successful submissions to
     the student directory -- one level up from the corresponding
     "SUCCESS-n" directory.  This is done only for files and
     directories that are newer in "SUCCESS-n" than in the submission
     root, other files and directories are left intact.  If external
     tools add new content to the student directory (eg, a "grade"
-    file, as described below) it will stay there. If the machine
+    file, as described below) it will stay there.  If the machine
     crashes or the server is stopped, the cleanup process might not
-    finish. When the server is started, it automatically runs the
+    finish.  When the server is started, it automatically runs the
     cleanup process for each student directory.
 
-    Within a student directory, a file "handin.scm" (or some other
-    name if `default-file-name' is set) contains the actual
-    submission. A `checker' procedure can change this default file
+    Within a student directory, a "handin.scm" file (or some other
+    name if the `default-file-name' option is set) contains the actual
+    submission.  A `checker' procedure can change this default file
     name, and it can create additional files in an "ATTEMPT" directory
-    (to be copied by the cleanup process); see below on "checker.ss"
-    for more details.
+    (to be copied by the cleanup process); see below for more details
+    on "checker.ss".
 
     For submissions from a normal DrScheme frame, a submission file
     contains a copy of the student's definitions and interactions
-    windows. The file is in a binary format (to support non-text
+    windows.  The file is in a binary format (to support non-text
     code), and opening the file directly in DrScheme shows the
-    definitions part. To get both the definitions and interactions
+    definitions part.  To get both the definitions and interactions
     parts, the file can be parsed with `unpack-submission' from
     "utils.ss" (see below).
 
     To submit an assignment as a group, students use a concatenation
     of usernames separated by "+" and any number of spaces (e.g.,
     "user1+user2").  The same syntax ("user1+user2") is used for the
-    directory for shared submissions, and the usernames are always
-    sorted so that the directory name is deterministic.  Multiple
+    directory for shared submissions, where the usernames are always
+    sorted so that directory names are deterministic.  Multiple
     submissions for a particular user in different groups will be
     rejected.
 
-  * "inactive/" --- sub-directory for inactive assignments, used by
-    the HTTPS status web server.
+    Inactive assignment directories are used by the the HTTPS status
+    web server.
 
-  * "active/<assignment>/checker.ss" (optional) --- a module that
-    exports a `checker' function.  This function receives two strings.
-    The first is a username list and the second is the submission as a
-    byte string.  (See also `unpack-submission', etc. from "util.ss",
-    below.)  To reject the submission, the `checker' function can
-    raise an exception; the exception message will be relayed back to
-    the student.  The module is loaded when the current directory is
-    the main server directory, so it can read information from
-    "config.ss".
+  * "<active-dir>/<assignment>/checker.ss" (optional) --- a module
+    that exports a `checker' function.  This function receives two
+    strings.  The first is a username list and the second is the
+    submission as a byte string.  (See also `unpack-submission',
+    etc. from "util.ss", below.)  To reject the submission, the
+    `checker' function can raise an exception; the exception message
+    will be relayed back to the student.  The module is loaded when
+    the current directory is the main server directory, so it can read
+    information from "config.ss".
 
     The first argument is a list of usernames with at least one
     username, and more than one if this is a joint submission (where
@@ -430,16 +455,16 @@ sub-directories:
     by "+").
 
     The `checker' function is called with the current directory as
-    "active/<assignment>/<username(s)>/ATTEMPT", and the submission is
+    "<active-assignment>/<username(s)>/ATTEMPT", and the submission is
     saved in the file "handin", and the timeout clock is reset to the
     value of the 'session-timeout configuration.  The checker function
     can change "handin", and it can create additional files in this
     directory.  (Extra files in the current directory will be
     preserved as it is later renamed to "SUCCESS-0", and copied to the
-    submission's root ("active/<assignment>/<user/s>/"), etc.)  To
-    hide generated files from the HTTPS status web server interface,
-    put the files in a subdirectory, which is preserved but hidden
-    from the status interface.
+    submission's root ("<active-assignment>/<username(s)>/"), etc.)
+    To hide generated files from the HTTPS status web server
+    interface, put the files in a subdirectory, it is preserved but
+    hidden from the status interface.
 
     The checker should return a string, such as "handin.scm", to use
     in naming the submission file, or #f to indicate that he file
@@ -469,31 +494,22 @@ sub-directories:
     To specify only pre/post-checker, use #f for the one you want to
     omit.
 
-  * "log" (or any other name that the 'log-file configuration option
-    specifies (if any), created if not present, appended otherwise)
-    --- records connections and actions, where each entry is of the
-    form
-        (id time-str msg-str)
-        [<id>|<time>] <msg>
-    where `<id>' is an integer representing the connection (numbered
-    consecutively from 1 when the server starts), "-" for a message
-    without a connection, and "wN" for a message from the status
-    servlet.
+  * "<[in]active-assignment>/<user(s)>/<filename>" (if submitted) ---
+    the most recent submission for <[in]active-assignment> by
+    <user(s)> where <filename> was returned by the checker (or the
+    value of the `default-file-name' configuration option if there's
+    no checker).  If the submission is from multiple users, then
+    "<user(s)>" is actually "<user1>+<user2>" etc.  Also, if the
+    cleanup process was interrupted (by a machine failure, etc.), the
+    submission may actually be in "SUCCESS-n" as described above, but
+    will move up when the server performs a cleanup (or when
+    restarted).
 
-  * "[in]active/<assignment>/<user>/<filename>" (if submitted) --- the
-    most recent submission for <assignment> by <user> where <filename>
-    was returned by the checker (or the value of the
-    `default-file-name' configuration option if there's no checker).
-    If the submission is from multiple users, then "<user>" is
-    actually "<user1>+<user2>" etc. Also, if the cleanup process was
-    interrupted (by a machine failure, etc.), the submission may
-    actually be in "SUCCESS-n" as described above.
+  * "<[in]active-assignment>/<user(s)>/grade" (optional) ---
+    <user(s)>'s grade for <assignment>, to be reported by the HTTPS
+    status web server
 
-  * "[in]active/<assignment>/<user>/grade" (optional) --- <user>'s
-    grade for <assignment>, to be reported by the HTTPS status web
-    server
-
-  * "[in]active/<assignment>/solution*" --- the solution to the
+  * "<[in]active-assignment>/solution*" --- the solution to the
     assignment, made available by the status server to any user who
     logs in.  The solution can be either a file or a directory with a
     name that begins with "solution".  In the first case, the status
@@ -510,7 +526,9 @@ related crashes.
 The server currently provides no mechanism for a graceful shutdown,
 but terminating the server is no worse than a network outage.  (In
 particular, no data should be lost.)  To reconfigure the server (e.g.,
-to change the set of active assignments), stop it and restart it.
+to change a checker module), stop it and restart it.  (Changing the
+configuration file is detected, and options are reloaded, so no
+restart is needed for that.)
 
 The client and server are designed to be robust against network
 problems and timeouts.  The client-side tool always provides a
@@ -691,7 +709,8 @@ The _utils.ss_ module provides utilities helpful in implementing
   Produces a line in the server log file, using the given format
   string and arguments.  All this actually does, is arrange to print
   the line fast (to avoid mixing lines from different threads) to the
-  error port, and flush it.
+  error port, and flush it.  (The log port will prefix all lines with
+  a time stamp and connection identifier.)
 
 > (timeout-control msg)
   Control the timeout for this session.  The timeout is initialized by
@@ -848,13 +867,12 @@ Keywords for configuring `check:':
   `current-value-printer' (see above).
 
 * :coverage? -- collect coverage information when evaluating the
-  submission.  This will
-  cause an error if some input is not covered.  This check happens
-  after checker tests are run, but the information is collected and
-  stored before, so checker tests do not change the result.  Also, you
-  can use the `!all-covered' procedure in the checker before other
-  tests, if you want that feedback earlier.
-  Does not work with non-textual submissions.
+  submission.  This will cause an error if some input is not covered.
+  This check happens after checker tests are run, but the information
+  is collected and stored before, so checker tests do not change the
+  result.  Also, you can use the `!all-covered' procedure in the
+  checker before other tests, if you want that feedback earlier.  Does
+  not work with non-textual submissions.
 
 Within the body of `check:', `users' and `submission' will be bound to
 the checker arguments -- a (sorted) list of usernames and the
diff --git a/collects/handin-server/extra-utils.ss b/collects/handin-server/extra-utils.ss
index bb32e0226f..411266b90c 100644
--- a/collects/handin-server/extra-utils.ss
+++ b/collects/handin-server/extra-utils.ss
@@ -30,8 +30,8 @@
 
 (provide submission-dir)
 (define submission-dir-re
-  (regexp (string-append "[/\\]active[/\\]([^/\\]+)[/\\](?:[^/\\]+)"
-                         "[/\\](?:SUCCESS-[0-9]+|ATTEMPT)[/\\]?$")))
+  (regexp (string-append "[/\\]([^/\\]+)[/\\](?:[^/\\]+)[/\\]"
+                         "(?:SUCCESS-[0-9]+|ATTEMPT)[/\\]?$")))
 (define (submission-dir)
   (let ([m (regexp-match submission-dir-re
                          (path->string (current-directory)))])
@@ -165,10 +165,9 @@
                     (read-bytes-line (current-input-port) 'any)))])
       (unless (eof-object? line)
         (let* ([line (regexp-replace #rx#"[ \t]+$" line #"")]
-               [line (if (and untabify?
-                              (regexp-match-positions #rx"\t" line))
+               [line (if (and untabify? (regexp-match? #rx"\t" line))
                        (untabify line) line)])
-          (when (and bad-re (regexp-match bad-re line))
+          (when (and bad-re (regexp-match? bad-re line))
             (error* "You cannot use \"~a\" in ~a!~a"
                     (if (regexp? bad-re) (object-name bad-re) bad-re)
                     (currently-processed-file-name)
@@ -285,14 +284,14 @@
   (let* ([files (read-multifile (open-input-bytes submission))]
          [names (map car files)])
     (cond [(ormap (lambda (f)
-                    (and (regexp-match #rx"^[.]|[/\\ ]" (car f)) (car f)))
+                    (and (regexp-match? #rx"^[.]|[/\\ ]" (car f)) (car f)))
                   files)
            => (lambda (file) (error* "bad filename: ~e" file))])
     (cond [(procedure? names-checker) (names-checker names)]
           [(or (regexp? names-checker)
                (string? names-checker) (bytes? names-checker))
            (cond [(ormap (lambda (n)
-                           (and (not (regexp-match names-checker n)) n))
+                           (and (not (regexp-match? names-checker n)) n))
                          names)
                   => (lambda (file) (error* "bad filename: ~e" file))])]
           [(and (list? names-checker) (andmap string? names-checker))
@@ -376,7 +375,7 @@
     (syntax-case stx ()
       [(key val x ...)
        (and (identifier? #'key)
-            (regexp-match #rx"^:" (symbol->string (syntax-e #'key))))
+            (regexp-match? #rx"^:" (symbol->string (syntax-e #'key))))
        (loop #'(x ...) (cons (list (syntax-e #'key) #'key #'val) keyvals))]
       [(body ...)
        (with-syntax
@@ -530,8 +529,8 @@
                                        [(not (string? user-error-message))
                                         (error*
                                          "badly configured user-error-message")]
-                                       [(regexp-match #rx"~[aesvAESV]"
-                                                      user-error-message)
+                                       [(regexp-match? #rx"~[aesvAESV]"
+                                                       user-error-message)
                                         (error* user-error-message m)]
                                        [else
                                         (error* "~a" user-error-message)])))])
diff --git a/collects/handin-server/handin-server.ss b/collects/handin-server/handin-server.ss
index ca5155afc2..5b9fbfc625 100644
--- a/collects/handin-server/handin-server.ss
+++ b/collects/handin-server/handin-server.ss
@@ -15,6 +15,10 @@
 
   (install-logger-port)
 
+  ;; errors to the user: no need for a "foo: " prefix
+  (define (error* fmt . args)
+    (error (apply format fmt args)))
+
   (define (write+flush port . xs)
     (for-each (lambda (x) (write x port) (newline port)) xs)
     (flush-output port))
@@ -45,9 +49,8 @@
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define ATTEMPT-DIR "ATTEMPT")
+  (define (success-dir n) (format "SUCCESS-~a" n))
 
-  (define (success-dir n)
-    (format "SUCCESS-~a" n))
   (define (make-success-dir-available n)
     (let ([name (success-dir n)])
       (when (directory-exists? name)
@@ -111,37 +114,29 @@
 
   (define (cleanup-all-submissions)
     (log-line "Cleaning up all submission directories")
-    (for-each (lambda (top)
-                (when (directory-exists? top)
-                  (parameterize ([current-directory top])
-                    (for-each (lambda (pset)
-                                (when (directory-exists? pset) ; filter non-dirs
-                                  (parameterize ([current-directory pset])
-                                    (for-each (lambda (sub)
-                                                (when (directory-exists? sub)
-                                                  (cleanup-submission sub)))
-                                              (directory-list)))))
+    (for-each (lambda (pset)
+                (when (directory-exists? pset) ; just in case
+                  (parameterize ([current-directory pset])
+                    (for-each (lambda (sub)
+                                (when (directory-exists? sub) ; filter non-dirs
+                                  (cleanup-submission sub)))
                               (directory-list)))))
-              '("active" "inactive")))
+              (get-conf 'all-dirs)))
 
   ;; On startup, we scan all submissions, then repeat at random intervals (only
   ;; if clients connected in that time), and check often for changes in the
   ;; active/inactive directories and run a cleanup if there was a change
   (define connection-num 0)
   (thread (lambda ()
-            (define last-active/inactive #f)
+            (define last-all-dirs #f)
             (define last-connection-num #f)
             (let loop ()
               (let loop ([n (+ 20 (random 20))]) ; 10-20 minute delay
                 (when (>= n 0)
-                  (let ([new (map (lambda (x)
-                                    (if (directory-exists? x)
-                                      (directory-list x)
-                                      null))
-                                  '("active" "inactive"))])
-                    (if (equal? new last-active/inactive)
+                  (let ([new (get-conf 'all-dirs)])
+                    (if (equal? new last-all-dirs)
                       (begin (sleep 30) (loop (sub1 n)))
-                      (begin (set! last-active/inactive new)
+                      (begin (set! last-all-dirs new)
                              (set! last-connection-num #f))))))
               (unless (equal? last-connection-num connection-num)
                 (cleanup-all-submissions)
@@ -154,27 +149,28 @@
     (with-output-to-file part
       (lambda () (display s))))
 
+  (define (users->dirname users)
+    (apply string-append (car users)
+           (map (lambda (u) (string-append "+" u)) (cdr users))))
+
   (define (accept-specific-submission data r r-safe w)
     ;; Note: users are always sorted
     (define users       (a-ref data 'usernames))
     (define assignments (a-ref data 'assignments))
     (define assignment  (a-ref data 'assignment))
-    (define dirname
-      (apply string-append (car users)
-             (map (lambda (u) (string-append "+" u)) (cdr users))))
+    (define dirname     (users->dirname users))
     (define len #f)
     (unless (member assignment assignments)
-      (error 'handin "not an active assignment: ~a" assignment))
+      (error* "not an active assignment: ~a" assignment))
     (log-line "assignment for ~a: ~a" users assignment)
     (write+flush w 'ok)
     (set! len (read r-safe))
     (unless (and (number? len) (integer? len) (positive? len))
-      (error 'handin "bad length: ~s" len))
+      (error* "bad length: ~s" len))
     (unless (len . < . (get-conf 'max-upload))
-      (error 'handin
-             "max handin file size is ~s bytes, file to handin is too big (~s bytes)"
-             (get-conf 'max-upload) len))
-    (parameterize ([current-directory (build-path "active" assignment)])
+      (error* "max handin file size is ~s bytes, file to handin is too big (~s bytes)"
+              (get-conf 'max-upload) len))
+    (parameterize ([current-directory (assignment<->dir assignment)])
       (wait-for-lock dirname
         (let ([dir (build-path (current-directory) dirname)])
           (lambda () (cleanup-submission dir))))
@@ -183,11 +179,11 @@
         (for-each wait-for-lock users))
       (write+flush w 'go)
       (unless (regexp-match #rx"[$]" r-safe)
-        (error 'handin "did not find start-of-content marker"))
+        (error* "did not find start-of-content marker"))
       (let ([s (read-bytes len r)])
         (unless (and (bytes? s) (= (bytes-length s) len))
-          (error 'handin "error uploading (got ~e, expected ~s bytes)"
-                 (if (bytes? s) (bytes-length s) s) len))
+          (error* "error uploading (got ~e, expected ~s bytes)"
+                  (if (bytes? s) (bytes-length s) s) len))
         ;; we have a submission, need to create a directory if needed, make
         ;; sure that no users submitted work with someone else
         (unless (directory-exists? dirname)
@@ -196,21 +192,20 @@
              (for-each
               (lambda (d)
                 (when (member d users)
-                  (error 'handin
-                         "bad submission: ~a has an existing submission (~a)"
-                         d dir)))
+                  (error* "bad submission: ~a has an existing submission (~a)"
+                          d dir)))
               (regexp-split #rx" *[+] *" (path->string dir))))
            (directory-list))
           (make-directory dirname))
         (parameterize ([current-directory dirname]
                        [current-messenger
                         (case-lambda
-                         [(msg) (write+flush w 'message msg)]
-                         [(msg styles)
-                          (if (eq? 'final styles)
-                            (write+flush w 'message-final msg)
-                            (begin (write+flush w 'message-box msg styles)
-                                   (read (make-limited-input-port r 50))))])])
+                          [(msg) (write+flush w 'message msg)]
+                          [(msg styles)
+                           (if (eq? 'final styles)
+                             (write+flush w 'message-final msg)
+                             (begin (write+flush w 'message-box msg styles)
+                                    (read (make-limited-input-port r 50))))])])
           ;; Clear out old ATTEMPT, if any, and make a new one:
           (when (directory-exists? ATTEMPT-DIR)
             (delete-directory/files ATTEMPT-DIR))
@@ -227,18 +222,18 @@
                     [(procedure? checker*) (values #f checker* #f)]
                     [(and (list? checker*) (= 3 (length checker*)))
                      (apply values checker*)]
-                    [else (error 'handin-configuration
-                                 "bad checker value: ~e" checker*)]))
+                    [else (error* "bad checker value: ~e" checker*)]))
             (when pre
               (let ([dir (current-directory)])
                 (with-handlers
                     ([void (lambda (e)
                              (parameterize ([current-directory dir])
-                               (unless (ormap
-                                        (lambda (d)
-                                          (and (directory-exists? d)
-                                               (regexp-match SUCCESS-RE d)))
-                                        (map path->string (directory-list)))
+                               (unless (ormap (lambda (d)
+                                                (and (directory-exists? d)
+                                                     (regexp-match
+                                                      SUCCESS-RE
+                                                      (path->string d))))
+                                              (directory-list))
                                  (parameterize ([current-directory ".."])
                                    (when (directory-exists? dirname)
                                      (delete-directory/files dirname)))))
@@ -265,23 +260,21 @@
                     (when post
                       (parameterize ([current-directory (success-dir 0)])
                         (post users s))))
-                  (error 'handin "upload not confirmed: ~s" v)))))))))
+                  (error* "upload not confirmed: ~s" v)))))))))
 
   (define (retrieve-specific-submission data w)
     ;; Note: users are always sorted
     (define users       (a-ref data 'usernames))
     (define assignments (a-ref data 'assignments))
     (define assignment  (a-ref data 'assignment))
-    (define dirname
-      (apply string-append (car users)
-             (map (lambda (u) (string-append "+" u)) (cdr users))))
-    (define submission-dir (build-path "active" assignment dirname))
+    (define dirname     (users->dirname users))
+    (define submission-dir (build-path (assignment<->dir assignment) dirname))
     (unless (member assignment assignments)
-      (error 'handin "not an active assignment: ~a" assignment))
+      (error* "not an active assignment: ~a" assignment))
     (unless (directory-exists? submission-dir)
-      (error 'handin "no ~a submission directory for ~a" assignment users))
+      (error* "no ~a submission directory for ~a" assignment users))
     (log-line "retrieving assignment for ~a: ~a" users assignment)
-    (parameterize ([current-directory (build-path "active" assignment dirname)])
+    (parameterize ([current-directory submission-dir])
       (define magics '(#"WXME" #"<<<MULTI-SUBMISSION-FILE>>>"))
       (define mlen (apply max (map bytes-length magics)))
       (define file
@@ -307,7 +300,7 @@
           (display "$" w)
           (display (with-input-from-file file (lambda () (read-bytes len))) w)
           (flush-output w))
-        (error 'handin "no ~a submission file found for ~a" assignment users))))
+        (error* "no ~a submission file found for ~a" assignment users))))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -321,7 +314,7 @@
        (put-preferences
         (list (string->symbol username)) (list data)
         (lambda (f)
-          (error 'handin "user database busy; please try again, and alert the adminstrator if problems persist"))
+          (error* "user database busy; please try again, and alert the adminstrator if problems persist"))
         "users.ss"))
      orig-custodian))
 
@@ -333,10 +326,9 @@
                   [(list? field-re) (member value field-re)]
                   [(not field-re) #t]
                   [(eq? field-re '-) #t] ; -> hidden field, no check
-                  [else (error 'handin "bad spec: field-regexp is ~e"
-                               field-re)])
-      (error 'handin "bad ~a: \"~a\"~a" field-name value
-             (if field-desc (format "; need ~a" field-desc) ""))))
+                  [else (error* "bad spec: field-regexp is ~e" field-re)])
+      (error* "bad ~a: \"~a\"~a" field-name value
+              (if field-desc (format "; need ~a" field-desc) ""))))
 
   ;; Utility for the next two functions: reconstruct a full list of
   ;; extra-fields from user-fields, using "" for hidden fields
@@ -354,24 +346,24 @@
     (define user-fields  (a-ref data 'user-fields))
     (define extra-fields (add-hidden-to-user-fields user-fields))
     (unless (get-conf 'allow-new-users)
-      (error 'handin "new users not allowed: ~a" username))
+      (error* "new users not allowed: ~a" username))
     (check-field username (get-conf 'user-regexp) "username"
                  (get-conf 'user-desc))
     ;; Since we're going to use the username in paths, and + to split names:
     (when (regexp-match #rx"[+/\\:|\"<>]" username)
-      (error 'handin "username must not contain one of the following: + / \\ : | \" < >"))
+      (error* "username must not contain these characters: + / \\ : | \" < >"))
     (when (regexp-match
            #rx"^((nul)|(con)|(prn)|(aux)|(clock[$])|(com[1-9])|(lpt[1-9]))[.]?"
            (string-foldcase username))
-      (error 'handin "username must not be a Windows special file name"))
+      (error* "username must not be a Windows special file name"))
     (when (regexp-match #rx"^[ .]|[ .]$" username)
-      (error 'handin "username must not begin or end with a space or period"))
+      (error* "username must not begin or end with a space or period"))
     (when (regexp-match #rx"^solution" username)
-      (error 'handin "the username prefix \"solution\" is reserved"))
+      (error* "the username prefix \"solution\" is reserved"))
     (when (string=? "checker.ss" username)
-      (error 'handin "the username \"checker.ss\" is reserved"))
+      (error* "the username \"checker.ss\" is reserved"))
     (when (get-user-data username)
-      (error 'handin "username already exists: `~a'" username))
+      (error* "username already exists: `~a'" username))
     (for-each (lambda (str info)
                 (check-field str (cadr info) (car info) (caddr info)))
               extra-fields (get-conf 'extra-fields))
@@ -386,17 +378,16 @@
     (define user-fields  (a-ref data 'user-fields))
     (define extra-fields (add-hidden-to-user-fields user-fields))
     (unless (= 1 (length usernames))
-      (error 'handin "cannot change a password for multiple users: ~a"
-             usernames))
+      (error* "cannot change a password for multiple users: ~a" usernames))
     ;; the new data is the same as the old one for every empty string (includes
     ;; hidden fields)
     (let ([new-data (map (lambda (old new) (if (equal? "" new) old new))
                          (car user-datas) (cons passwd extra-fields))])
       (unless (or (get-conf 'allow-change-info)
                   (equal? (cdr new-data) (cdar user-datas)))
-        (error 'handin "changing information not allowed: ~a" (car usernames)))
+        (error* "changing information not allowed: ~a" (car usernames)))
       (when (equal? new-data (car user-datas))
-        (error 'handin "no fields changed: ~a" (car usernames)))
+        (error* "no fields changed: ~a" (car usernames)))
       (for-each (lambda (str info)
                   (check-field str (cadr info) (car info) (caddr info)))
                 (cdr new-data) (get-conf 'extra-fields))
@@ -407,7 +398,7 @@
   (define (get-user-info data)
     (define usernames  (a-ref data 'usernames))
     (unless (= 1 (length usernames))
-      (error 'handin "cannot get user-info for multiple users: ~a" usernames))
+      (error* "cannot get user-info for multiple users: ~a" usernames))
     ;; filter out hidden fields
     (let ([all-data (cdar (a-ref data 'user-datas))])
       (filter values (map (lambda (d f)
@@ -426,7 +417,7 @@
     (define (good? passwd)
       (define (bad-password msg)
         (log-line "ERROR: ~a -- ~s" msg passwd)
-        (error 'handin "bad password in user database"))
+        (error* "bad password in user database"))
       (cond [(string? passwd) (equal? md5 passwd)]
             [(and (list? passwd) (= 2 (length passwd))
                   (symbol? (car passwd)) (string? (cadr passwd)))
@@ -513,8 +504,8 @@
                            (cons (get-conf 'master-password)
                                  (map car user-datas)))))
              (log-line "failed login: ~a" (a-ref data 'username/s))
-             (error 'handin "bad username or password for ~a"
-                    (a-ref data 'username/s)))
+             (error* "bad username or password for ~a"
+                     (a-ref data 'username/s)))
            (log-line "login: ~a" usernames))
          (case msg
            [(change-user-info) (change-user-info data)]
@@ -525,7 +516,7 @@
     (write+flush w 'ok)) ; final confirmation for *all* actions
 
   (define (assignment-list)
-    (sort (map path->string (directory-list "active")) string<?))
+    (map assignment<->dir (get-conf 'active-dirs)))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/collects/handin-server/private/config.ss b/collects/handin-server/private/config.ss
index ef37b51c62..3949e7ab39 100644
--- a/collects/handin-server/private/config.ss
+++ b/collects/handin-server/private/config.ss
@@ -19,7 +19,6 @@
     (unless (and raw-config
                  (< (- (current-inexact-milliseconds) last-poll) poll-freq))
       (set! last-poll (current-inexact-milliseconds))
-      (printf "polling...\n")
       (let ([filetime (file-or-directory-modify-seconds config-file)])
         (unless (and filetime (equal? filetime last-filetime))
           (set! last-filetime filetime)
@@ -28,7 +27,6 @@
                                         (error 'get-conf
                                                "could not read conf (~a)"
                                                config-file))])
-                  (printf "reading...\n")
                   (with-input-from-file config-file read)))
           (set! config-cache (make-hash-table)))))
     (hash-table-get config-cache key
@@ -46,9 +44,12 @@
   (define (rx s) (if (regexp? s) s (regexp s)))
   (define (path p) (path->complete-path p server-dir))
   (define (path/false p) (and p (path p)))
+  (define (path-list l) (map path l))
 
   (define (config-default+translate which)
     (case which
+      [(active-dirs)             (values '()                   path-list    )]
+      [(inactive-dirs)           (values '()                   path-list    )]
       [(port-number)             (values 7979                  id           )]
       [(https-port-number)       (values (add1 (get-conf 'port-number))  id )]
       [(session-timeout)         (values 300                   id           )]
@@ -73,10 +74,32 @@
                   "a valid email address"))
                id)]
       ;; computed from the above (mark by translate = #f)
+      [(all-dirs)
+       (values (append (get-conf 'active-dirs) (get-conf 'inactive-dirs)) #f)]
+      [(names-dirs) ; see below
+       (values (paths->map (get-conf 'all-dirs)) #f)]
       [(user-fields)
        (values (filter (lambda (f) (not (eq? '- (cadr f))))
                        (get-conf 'extra-fields))
                #f)]
       [else (error 'get-conf "unknown configuration entry: ~s" which)]))
 
+  ;; This is used below to map names to submission directory paths and back
+  ;; returns a (list-of (either (list name path) (list path name)))
+  (define (paths->map dirs)
+    (define (path->name dir)
+      (unless (directory-exists? dir)
+        (error 'get-conf
+               "directory entry for an inexistent directory: ~e" dir))
+      (let-values ([(_1 name _2) (split-path dir)])
+        (bytes->string/locale (path-element->bytes name))))
+    (let ([names (map path->name dirs)])
+      (append (map list names dirs) (map list dirs names))))
+
+  ;; Translates an assignment name to a directory path or back
+  (provide assignment<->dir)
+  (define (assignment<->dir a/d)
+    (cond [(assoc a/d (get-conf 'names-dirs)) => cadr]
+          [else (error 'assignment<->dir "internal error: ~e" a/d)]))
+
   )
diff --git a/collects/handin-server/status-web-root/servlets/status.ss b/collects/handin-server/status-web-root/servlets/status.ss
index 163ad529d8..726ed33fe1 100644
--- a/collects/handin-server/status-web-root/servlets/status.ss
+++ b/collects/handin-server/status-web-root/servlets/status.ss
@@ -10,10 +10,6 @@
            (lib "logger.ss" "handin-server" "private")
            (lib "config.ss" "handin-server" "private"))
 
-  (define active-dir   (build-path server-dir "active"))
-  (define inactive-dir (build-path server-dir "inactive"))
-  (define active/inactive-dirs (list active-dir inactive-dir))
-
   (define get-user-data
     (let ([users-file (build-path server-dir "users.ss")])
       (lambda (user)
@@ -40,7 +36,7 @@
             "/")))))
 
   (define (make-k k tag)
-    (format "~a~atag=~a" k (if (regexp-match #rx"^[^#]*[?]" k) "&" "?")
+    (format "~a~atag=~a" k (if (regexp-match? #rx"^[^#]*[?]" k) "&" "?")
             (uri-encode (regexp-replace handin-prefix-re
                                         (if (path? tag) (path->string tag) tag)
                                         ""))))
@@ -51,24 +47,22 @@
   ;; `look-for' can be a username as a string (will find "bar+foo" for "foo"),
   ;; or a regexp that should match the whole directory name (used with
   ;; "^solution" below)
-  (define (find-hi-entry hi look-for)
-    (define (find-submission top)
-      (let ([dir (build-path top hi)])
-        (and (directory-exists? dir)
-             (ormap
-              (lambda (d)
-                (let ([d (path->string d)])
-                  (and (cond [(string? look-for)
-                              (member look-for (regexp-split #rx" *[+] *" d))]
-                             [(regexp? look-for) (regexp-match look-for d)]
-                             [else (error 'find-hi-entry
-                                          "internal error: ~e" look-for)])
-                       (build-path dir d))))
-              (directory-list dir)))))
-    (ormap find-submission active/inactive-dirs))
+  (define (find-handin-entry hi look-for)
+    (let ([dir (assignment<->dir hi)])
+      (and (directory-exists? dir)
+           (ormap
+            (lambda (d)
+              (let ([d (path->string d)])
+                (and (cond [(string? look-for)
+                            (member look-for (regexp-split #rx" *[+] *" d))]
+                           [(regexp? look-for) (regexp-match? look-for d)]
+                           [else (error 'find-handin-entry
+                                        "internal error: ~e" look-for)])
+                     (build-path dir d))))
+            (directory-list dir)))))
 
   (define (handin-link k user hi)
-    (let* ([dir (find-hi-entry hi user)]
+    (let* ([dir (find-handin-entry hi user)]
            [l (and dir (with-handlers ([exn:fail? (lambda (x) null)])
                          (parameterize ([current-directory dir])
                            (sort (filter (lambda (f)
@@ -94,7 +88,8 @@
                       user hi)))))
 
   (define (solution-link k hi)
-    (let ([soln (find-hi-entry hi #rx"^solution")]
+    (let ([soln (and (member (assignment<->dir hi) (get-conf 'inactive-dirs))
+                     (find-handin-entry hi #rx"^solution"))]
           [none `((i "---"))])
       (cond [(not soln) none]
             [(file-exists? soln)
@@ -115,7 +110,7 @@
             [else none])))
 
   (define (handin-grade user hi)
-    (let* ([dir (find-hi-entry hi user)]
+    (let* ([dir (find-handin-entry hi user)]
            [grade (and dir
                        (let ([filename (build-path dir "grade")])
                          (and (file-exists? filename)
@@ -140,51 +135,42 @@
 
   (define re:base #rx"^([a-zA-Z]*)([0-9]+)")
   (define (all-status-page user)
-    (let* ([l (sort
-               (map path->string
-                    (append (directory-list active-dir)
-                            (with-handlers ([exn:fail? (lambda (x) null)])
-                              (directory-list inactive-dir))))
-               (lambda (a b)
-                 (let ([am (regexp-match re:base a)]
-                       [bm (regexp-match re:base b)])
-                   (if (and am bm
-                            (string=? (cadr am) (cadr bm)))
-                     (or (< (string->number (caddr am))
-                            (string->number (caddr bm)))
-                         (string<? a b))
-                     (string<? a b)))))]
-           [next
+    (define (cell  . texts) `(td ([bgcolor "white"]) ,@texts))
+    (define (rcell . texts) `(td ([bgcolor "white"] [align "right"]) ,@texts))
+    (define (header . texts) `(td ([bgcolor "#f0f0f0"]) (big (strong ,@texts))))
+    (define ((row k active?) dir)
+      (let ([hi (assignment<->dir dir)])
+        `(tr ([valign "top"])
+           ,(apply header hi
+                   (if active? `((br) (small (small "[active]"))) '()))
+           ,(apply cell (handin-link k user hi))
+           ,(rcell (handin-grade user hi))
+           ,(apply cell (solution-link k hi)))))
+    (let* ([next
             (send/suspend
              (lambda (k)
-               (define (header text)
-                 `(td ((bgcolor "#f0f0f0")) (big (strong ,text))))
                (make-page
                 (format "All Handins for ~a" user)
                 `(table ([bgcolor "#ddddff"] [cellpadding "6"] [align "center"])
                    (tr () ,@(map header '(nbsp "Files" "Grade" "Solution")))
-                   ,@(map (lambda (hi)
-                            `(tr ([valign "top"])
-                               ,(header hi)
-                               (td ([bgcolor "white"]) ,@(handin-link k user hi))
-                               (td ([bgcolor "white"] (align "right")) ,(handin-grade user hi))
-                               (td ([bgcolor "white"]) ,@(solution-link k hi))))
-                          l)))))]
+                   ,@(append (map (row k #t) (get-conf 'active-dirs))
+                             (map (row k #f) (get-conf 'inactive-dirs)))))))]
            [tag (select-k next)])
       (download user tag)))
 
   (define (download who tag)
-    (define (check path elts)
+    (define (check path elts allow-active?)
       (let loop ([path path] [elts (reverse elts)])
         (let*-values ([(base name dir?) (split-path path)]
                       [(name) (path->string name)]
                       [(check) (and (pair? elts) (car elts))])
           (if (null? elts)
-            ;; must be rooted in active/inactive (why build-path instead of
-            ;; using `path'? -- because path will have a trailing slash)
-            (member (build-path base name) active/inactive-dirs)
+            ;; must be rooted in a submission directory (why build-path instead
+            ;; of using `path'? -- because path will have a trailing slash)
+            (member (build-path base name)
+                    (get-conf (if allow-active? 'all-dirs 'inactive-dirs)))
             (and (cond [(eq? '* check) #t]
-                       [(regexp? check) (regexp-match check name)]
+                       [(regexp? check) (regexp-match? check name)]
                        [(string? check)
                         (or (equal? name check)
                             (member check (regexp-split #rx" *[+] *" name)))]
@@ -194,16 +180,16 @@
     (with-handlers ([exn:fail? (lambda (exn)
                                  (make-page "Error" "Illegal file access"))])
       ;; Make sure the user is allowed to read the requested file:
-      (or (check file `(* ,who *))
-          (check file `(* #rx"^solution"))
-          (check file `(* #rx"^solution" *))
+      (or (check file `(,who *) #t)
+          (check file `(#rx"^solution") #f)
+          (check file `(#rx"^solution" *) #f)
           (error "Boom!"))
       (log-line "Status file-get: ~s ~a" who file)
       ;; Return the downloaded file
       (let* ([data (with-input-from-file file
                      (lambda () (read-bytes (file-size file))))]
-             [html? (regexp-match #rx"[.]html?$" (string-foldcase tag))]
-             [wxme? (regexp-match #rx#"^WXME" data)])
+             [html? (regexp-match? #rx"[.]html?$" (string-foldcase tag))]
+             [wxme? (regexp-match? #rx#"^WXME" data)])
         (make-response/full 200 "Okay" (current-seconds)
           (cond [html? #"text/html"]
                 [wxme? #"application/data"]