user checker that uses a team file dynamically

svn: r1261

collects/handin-server/doc.txt

@@ -371,8 +371,8 @@ sub-directories:
     submissions for a particular user in different groups will be
     rejected.
 
-  * "inactive/" --- sub-directory for inactive assignments, used by the
+  * "inactive/" --- sub-directory for inactive assignments, used by
-    HTTPS status web server.
+    the HTTPS status web server.
 
   * "active/<assignment>/checker.ss" (optional) --- a module that
     exports a `checker' function.  This function receives two strings.
@@ -401,8 +401,8 @@ sub-directories:
     put the files in a subdirectory, which is preserved but hidden
     from the status interface.
 
-    The checker should return a string, such as "handin.scm", to use in
+    The checker should return a string, such as "handin.scm", to use
-    naming the submission file.
+    in naming the submission file.
 
     Alternatively, the module can bind `checker' to a list of three
     procedures: a pre-checker, a checker, and a post-checker.  All
@@ -566,15 +566,15 @@ The _utils.ss_ module provides utilities helpful in implementing
   submission byte string.
 
 
-> coverage-enabled - parameter that controls whether coverage testing is
+> coverage-enabled - parameter that controls whether coverage testing
-  enabled.  If it set to true, the errortrace collection will be used
+  is enabled.  If it set to true, the errortrace collection will be
-  to collect coverage information during evaluation of the submission,
+  used to collect coverage information during evaluation of the
-  this information is collected before additional checker-evaluations.
+  submission, this information is collected before additional
-  To retrieve the collected information, apply the evaluation function
+  checker-evaluations.  To retrieve the collected information, apply
-  with a second argument of 'execute-counts (the first argument will
+  the evaluation function with a second argument of 'execute-counts
-  be ignored).  The resulting value is the same as the result of
+  (the first argument will be ignored).  The resulting value is the
-  errortrace's `get-execute-counts', with all non-submission entries
+  same as the result of errortrace's `get-execute-counts', with all
-  filtered out.
+  non-submission entries filtered out.
 
 
 > (check-proc eval expect-v compare-proc proc-name arg ...) - calls
@@ -843,6 +843,19 @@ value from the submission code.
   will often try to submit their work alone, and later on re-submit
   with a partner.
 
+> (teams-in-file team-file)
+  This procedure *returns* a procedure that can be used for the :users
+  entry in a checker.  The team file (relative from the server's main
+  directory) is expected to have user entries -- a sequence of
+  s-expressions, each one a string or a list of strings.  The
+  resulting procedure will allow submission only by teams that are
+  specified in this file.  Furthermore, if this file is modified, the
+  new contents will be used immediately, so there is no need to
+  restart the server of you want to change student teams.  (But
+  remember that if you change ("foo" "bar") to ("foo" "baz"), and
+  there is already a "bar+foo" submission directory, then the system
+  will not allow "foo" to submit with "bar".)
+
 > (add-header-line! line)
   During the checker operation, this procedure can be used to add
   header lines to the text version of the submitted file.  It will not

collects/handin-server/extra-utils.ss

@@ -453,6 +453,33 @@
     [(1) (warn-single (car users))]
     [else (error* "too many users in the team: ~a" users)]))
 
+(provide teams-in-file)
+(define (teams-in-file file)
+  (define last-time 0)
+  (define teams '())
+  (define file* (build-path server-dir file))
+  (define (read-teams!)
+    (let ([cur-time (file-or-directory-modify-seconds file*)])
+      (unless (equal? last-time cur-time)
+        (set! last-time cur-time)
+        (set! teams
+              (with-input-from-file file*
+                (lambda ()
+                  (let loop ([r '()])
+                    (let ([x (read)])
+                      (cond [(eof-object? x) (reverse! r)]
+                            [(null? x) (loop r)]
+                            [(list? x) (loop (cons (quicksort x string<?) r))]
+                            [else      (loop (cons (list x) r))])))))))))
+  (lambda (users)
+    (read-teams!)
+    (unless (member users teams)
+      (error* "You are not registered ~a for this submission"
+              (case (length users)
+                [(1) "for individual submission"]
+                [(2) "as a pair"]
+                [else "as a group"])))))
+
 ;; ============================================================================
 ;; Checker utilities