Completed cleaup facility
svn: r821
This commit is contained in:
Eli Barzilay
parent
a7788ad50f
commit
9fbf8f47eb
|
|
@ -202,6 +202,8 @@ sub-directories:
|
|||
|
||||
'username-case-sensitive? : a boolean; when #f, usernames
|
||||
are case-folded for all purposes; defaults to #f
|
||||
(note that you should not set this to #t on Windows, since
|
||||
usernames are used as directory names)
|
||||
|
||||
'id-regexp : a regular expression that is used to validate a
|
||||
"free form" user id (possibly a student id) for a created
|
||||
|
|
@ -260,10 +262,10 @@ sub-directories:
|
|||
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.
|
||||
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.
|
||||
|
||||
Within an "ATTEMPT" or "SUCCESS-n" directory, a file "handin.scm"
|
||||
(or some other name if `default-file-name' is set) contains the
|
||||
|
|
@ -272,6 +274,14 @@ sub-directories:
|
|||
"ATTEMPT"/"SUCCESS-n" directory or in the student directory; see
|
||||
below on "checker.ss" for more details.
|
||||
|
||||
A cleanup process will copy successful submission to the
|
||||
submission root -- 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. This means that you can have
|
||||
external tools that add new content to the submission directory
|
||||
(eg, a "grade" file as described below) and it will stay there.
|
||||
|
||||
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
|
||||
|
|
@ -302,12 +312,13 @@ sub-directories:
|
|||
The `checker' function is called with the current directory as
|
||||
"active/<assignment>/<user/s>/ATTEMPT", and the submission is
|
||||
saved in the file "handin". The checker function can change
|
||||
"handin", and it can create additional files in this directory or
|
||||
the parent directory. (Extra files in the current directory will
|
||||
be preserved as it is later renamed to "SUCCESS-0", 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.
|
||||
"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.
|
||||
|
||||
The checker should return either a string or a list of two
|
||||
strings. A single string result, such as "handin.scm", is used to
|
||||
|
|
|
|||
|
|
@ -82,12 +82,24 @@
|
|||
(define SUCCESS-RE (regexp (format "^~a$" (success-dir "[0-9]+"))))
|
||||
(define SUCCESS-GOOD (map success-dir '(0 1)))
|
||||
|
||||
(define-syntax careful-switch-directory-switch
|
||||
(syntax-rules ()
|
||||
[(_ ?dir body ...)
|
||||
(let ([dir (with-handlers ([void (lambda _ #f)]) (normalize-path ?dir))])
|
||||
(when (and dir (directory-exists? dir))
|
||||
(parameterize ([current-directory (current-directory)])
|
||||
(when (with-handlers ([void (lambda _ #f)])
|
||||
(current-directory dir) #t)
|
||||
body ...))))]))
|
||||
|
||||
(define (cleanup-submission dir)
|
||||
;; This is called at a lock cleanup, so it is important that it does not
|
||||
;; throw an exception, or the whole server will be locked down. It is
|
||||
;; invoked just before the lock is released, so fine to assume that we have
|
||||
;; exclusive access to the directory contents.
|
||||
(when (directory-exists? dir)
|
||||
(with-handlers ([_ (lambda (e)
|
||||
(LOG "*** ERROR DURING (cleanup-submission ~s) : ~a"
|
||||
dir (if (exn? e) (exn-message e) e)))])
|
||||
(parameterize ([current-directory dir])
|
||||
;; Find the newest SUCCESS dir -- ignore ATTEMPT, since if it exist it
|
||||
;; means that there was a failed submission and the next one will
|
||||
|
|
@ -104,37 +116,59 @@
|
|||
(unless (member dir SUCCESS-GOOD)
|
||||
(LOG "*** USING AN UNEXPECTED SUBMISSION DIRECTORY: ~a"
|
||||
(build-path (current-directory) dir)))
|
||||
;; We have a submission directory -- copy all newer things
|
||||
;; (extra things that exist in the main submission directory but
|
||||
;; not in SUCCESS, or things that are newer in the main submission
|
||||
;; We have a submission directory -- copy all newer things (extra
|
||||
;; things that exist in the main submission directory but not in
|
||||
;; SUCCESS, or things that are newer in the main submission
|
||||
;; directory are kept (but subdirs in SUCCESS will are copied as
|
||||
;; is))
|
||||
(for-each
|
||||
(lambda (f)
|
||||
(define dir/f (build-path dir f))
|
||||
(cond [(not (or (file-exists? f) (directory-exists? f)))
|
||||
;; f is in dir but not in the working directory
|
||||
(copy-directory/files (build-path dir f) f)]
|
||||
[(<= (file-or-directory-modify-seconds f)
|
||||
(file-or-directory-modify-seconds (build-path dir f)))
|
||||
(copy-directory/files dir/f f)]
|
||||
[(or (<= (file-or-directory-modify-seconds f)
|
||||
(file-or-directory-modify-seconds dir/f))
|
||||
(and (file-exists? f) (file-exists? dir/f)
|
||||
(not (= (file-size f) (file-size dir/f)))))
|
||||
;; f is newer in dir than in the working directory
|
||||
(delete-directory/files f)
|
||||
(copy-directory/files (build-path dir f) f)]))
|
||||
(copy-directory/files dir/f f)]))
|
||||
(directory-list dir)))))))
|
||||
|
||||
;; On startup, we scan *all* submissions
|
||||
(LOG "Cleaning up 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)))))
|
||||
(directory-list)))))
|
||||
'("active" "inactive"))
|
||||
(define (cleanup-all-submissions)
|
||||
(LOG "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)))))
|
||||
(directory-list)))))
|
||||
'("active" "inactive")))
|
||||
|
||||
;; 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
|
||||
(thread (lambda ()
|
||||
(define last-active/inactive #f)
|
||||
(define last-connection-num #f)
|
||||
(let loop ()
|
||||
(let loop ([n (+ 20 (random 20))]) ; 10-20 minute delay
|
||||
(when (>= n 0)
|
||||
(let ([new (map directory-list '("active" "inactive"))])
|
||||
(if (equal? new last-active/inactive)
|
||||
(begin (sleep 30) (loop (sub1 n)))
|
||||
(begin (set! last-active/inactive new)
|
||||
(set! last-connection-num #f))))))
|
||||
(unless (equal? last-connection-num connection-num)
|
||||
(cleanup-all-submissions)
|
||||
(set! last-connection-num connection-num))
|
||||
(loop))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -251,8 +285,8 @@
|
|||
(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"))
|
||||
(when (regexp-match #rx"[ .]$" username)
|
||||
(error 'handin "username must not end with a space or period"))
|
||||
(when (regexp-match #rx"^[ .]|[ .]$" username)
|
||||
(error 'handin "username must not begin or end with a space or period"))
|
||||
(when (string=? "solution" username)
|
||||
(error 'handin "the username \"solution\" is reserved"))
|
||||
(when (string=? "checker.ss" username)
|
||||
|
|
@ -305,16 +339,8 @@
|
|||
(error 'handin "username must not contain a \"+\": ~a" user-string))
|
||||
;; we now know that there is a single username, and (car usernames) is
|
||||
;; the same at user-string
|
||||
(when (or (car user-datas)
|
||||
(and USERNAME-CASE-SENSITIVE?
|
||||
;; Force case-folding for existing-username check:
|
||||
(get-preference (string->symbol (string-foldcase user-string))
|
||||
(lambda () #f) #f "users.ss")))
|
||||
(error 'handin "~ausername already exists: `~a'"
|
||||
(if (car user-datas)
|
||||
""
|
||||
"case-folded equivalent ")
|
||||
user-string))
|
||||
(when (car user-datas)
|
||||
(error 'handin "username already exists: `~a'" user-string))
|
||||
(add-new-user user-string r-safe w)]
|
||||
[(and (pair? user-datas)
|
||||
(not (memq #f user-datas))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user