warn agains file loss on multi-file submissions

svn: r2227

collects/handin-server/doc.txt

@@ -966,19 +966,28 @@ On the server side, each submission is saved in a file called "raw",
 which contains all submitted files.  In the "grading" directory, you
 will get a "text.<sfx>" file ("<sfx>" is the suffix that is used as a
 value for `:multi-file') that contains all submitted files with clear
-separators.  On the client side, students will have an additional
+separators.  A possible confusion is that every submission is a
-file-menu entry for submitting multiple files, which pops up a dialog
+complete set of files that overwrites any existing submission -- but
-that can be used to submit multiple files.  In this dialog, students
+students may think that the server accumulates incoming files.  To
-choose their working directory, and the `selection-default' entry from
+avoid such confusion, when a submission arrives an there is already an
-the "handin-client/info.ss" file specifies a few patterns that can be
+existing previous submission, the contents is compared, and if there
-used to automatically select files.
+are files that existed in the old submission but not in the new ones,
+the student will see a warning pop-up that allows aborting the
+submission.
 
-The dialog provides all handin-related functionality that is available
+On the client side, students will have an additional file-menu entry
-in DrScheme.  For further convenience, it can be used as a standalone
+for submitting multiple files, which pops up a dialog that can be used
-application: in the account management dialog, the "Un/Install" tab
+to submit multiple files.  In this dialog, students choose their
-has a button that will ask for a directory where it will create an
+working directory, and the `selection-default' entry from the
-executable for the multi-file submission utility -- the resulting
+"handin-client/info.ss" file specifies a few patterns that can be used
-executable can be used outside of DrScheme.
+to automatically select files.  The dialog provides all handin-related
+functionality that is available in DrScheme.  For further convenience,
+it can be used as a standalone application: in the account management
+dialog, the "Un/Install" tab has a button that will ask for a
+directory where it will create an executable for the multi-file
+submission utility -- the resulting executable can be used outside of
+DrScheme (but PLT Scheme is still required, so it cannot be
+uninstalled).
 
 *** Auto-updater
 

collects/handin-server/extra-utils.ss

@@ -48,10 +48,10 @@
     (let* ([m (regexp-match-positions #rx"{([^{}]+)}" str)]
            [s (and m (substring str (caadr m) (cdadr m)))])
       (if m
-        (subst (string-append (substring str 0 (caar m))
+        (subst (string-append
+                (substring str 0 (caar m))
                 (cond [(assoc s substs) => cdr]
-                                    [else (error 'subst
+                      [else (error 'subst "unknown substitution: ~s" s)])
-                                                 "unknown substitution: ~s" s)])
                 (substring str (cdar m)))
                substs)
         str))))
@@ -244,42 +244,65 @@
 ;; ============================================================================
 ;; Dealing with multi-file submissions
 
-(define ((unpack-multifile-submission names-checker)
+(define (read-multifile . port)
-         submission maxwidth textualize? untabify?
+  (define magic #"<<<MULTI-SUBMISSION-FILE>>>")
-         markup-prefix prefix-re)
   (define (assert-format b)
     (unless b
       (error* "bad submission format, expecting a multi-file submission -- ~a"
               "use the multi-file submission tool")))
-  (let ([files
+  (define (read-it)
-         (parameterize ([current-input-port (open-input-bytes submission)])
-           (define magic #"<<<MULTI-SUBMISSION-FILE>>>")
     (assert-format (equal? magic (read-bytes (bytes-length magic))))
     (let loop ([files '()])
       (let ([f (with-handlers ([void void]) (read))])
         (if (eof-object? f)
           (quicksort files (lambda (x y) (string<? (car x) (car y))))
-                 (loop (cons f files))))))])
+          (loop (cons f files))))))
+  (let ([files (if (pair? port)
+                 (parameterize ([current-input-port (car port)]) (read-it))
+                 (read-it))])
     (assert-format (and (list? files)
                         (andmap (lambda (x)
                                   (and (list? x) (= 2 (length x))
                                        (string? (car x)) (bytes? (cadr x))))
                                 files)))
+    files))
+
+(define ((unpack-multifile-submission names-checker raw-file-name)
+         submission maxwidth textualize? untabify?
+         markup-prefix prefix-re)
+  (let* ([files (read-multifile (open-input-bytes submission))]
+         [names (map car files)])
     (cond [(ormap (lambda (f)
                     (and (regexp-match #rx"^[.]|[/\\ ]" (car f)) (car f)))
                   files)
            => (lambda (file) (error* "bad filename: ~e" file))])
-    ((cond [(procedure? names-checker) names-checker]
+    (cond [(procedure? names-checker) (names-checker names)]
           [(or (regexp? names-checker)
                (string? names-checker) (bytes? names-checker))
-            (lambda (names)
            (cond [(ormap (lambda (n)
                            (and (not (regexp-match names-checker n)) n))
                          names)
-                     => (lambda (file) (error* "bad filename: ~e" file))]))]
+                  => (lambda (file) (error* "bad filename: ~e" file))])]
-           [(not names-checker) void]
+          [names-checker (error* "bad names-checker specification: ~e"
-           [else (error* "bad names-checker specification: ~e" names-checker)])
+                                 names-checker)])
-     (map car files))
+    ;; problem: students might think that submitting files one-by-one will keep
+    ;; them all; solution: if there is already a submission, then warn against
+    ;; files that disappear.
+    (let* ([raw (build-path 'up raw-file-name)]
+           [old (and (file-exists? raw)
+                     (with-handlers ([void (lambda _ #f)])
+                       (with-input-from-file raw read-multifile)))]
+           [removed (and old (remove* names (map car old)))])
+      (when (and (pair? removed)
+                 (not (eq? 'ok (message
+                                (apply string-append
+                                       "The following file"
+                                       (if (pair? (cdr removed)) "s" "")
+                                       " will be lost:"
+                                       (map (lambda (n) (string-append " " n))
+                                            removed))
+                                '(ok-cancel caution)))))
+        (error* "Aborting...")))
     ;; This will create copies of the original files
     ;; (for-each (lambda (file)
     ;;             (with-output-to-file (car file)
@@ -448,6 +471,7 @@
                  (define (prefix-line str)
                    (printf "~a~a\n" markup-prefix str))
                  (define (write-text)
+                   (current-run-status "creating text file")
                    (with-output-to-file text-file
                      (lambda ()
                        (for-each (lambda (user)
@@ -461,11 +485,13 @@
                      'truncate))
                  (define submission-text
                    (and create-text?
+                        (begin (current-run-status "reading submission")
                                ((if multi-file
-                           (unpack-multifile-submission names-checker)
+                                  (unpack-multifile-submission
+                                   names-checker output-file)
                                   submission->bytes)
                                 submission maxwidth textualize? untabify?
-                          markup-prefix prefix-re)))
+                                markup-prefix prefix-re))))
                  (when create-text? (make-directory "grading") (write-text))
                  (when value-printer (current-value-printer value-printer))
                  (when coverage? (coverage-enabled #t))