Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

semaphore for cleanup, configurable error messages

svn: r827
  • Loading branch information...
commit 690c4b251784d3c030368ce619473c3949e81cb9 1 parent 6cb6343
@elibarzilay elibarzilay authored
View
15 collects/handin-server/doc.txt
@@ -200,6 +200,11 @@ sub-directories:
are impossible to remember, and forget capitalization; the
default is fairly strict: #rx"^[a-z][a-z0-9]+$"
+ 'user-desc : a plain-words description of the acceptable
+ username format (according to user-regexp above); #f stands
+ for no description; the default is "alphanumeric string"
+ which matches the default user-regexp
+
'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
@@ -209,8 +214,9 @@ sub-directories:
"free form" user id (possibly a student id) for a created
account; the default is #rx"^.*$"
- 'id-desc : a plain-words description of the acceptable format
- for a "free form" id; the default is "anything"
+ 'id-desc : a plain-words description of the acceptable id format
+ (according to id-regexp above), eg, "Foo ID Number"; the
+ default is #f indicating no description
'email-regexp : a regular expression that is used to validate
emails, the #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"
@@ -218,6 +224,11 @@ sub-directories:
or can be further restricted, for example requiring a
"@cs.foo.edu" suffix
+ 'email-desc : a plain-words description of the acceptable email
+ format (according to email-regexp above), eg, "Foo CS email";
+ #f stands for no description; the default is "a valid email
+ address"
+
'allow-new-users : a boolean indicating whether to allow
new-user requests from a client tool; the default is #f
View
41 collects/handin-server/handin-server.ss
@@ -43,10 +43,12 @@
(define MAX-UPLOAD (get-config 'max-upload 500000))
(define MAX-UPLOAD-KEEP (get-config 'max-upload-keep 9))
(define USER-REGEXP (get-config 'user-regexp #rx"^[a-z][a-z0-9]+$"))
+ (define USER-DESC (get-config 'user-desc "alphanumeric string"))
(define USERNAME-CASE-SENSITIVE? (get-config 'username-case-sensitive? #f))
(define ID-REGEXP (get-config 'id-regexp #rx"^.*$"))
- (define ID-DESC (get-config 'id-desc "anything"))
+ (define ID-DESC (get-config 'id-desc #f))
(define EMAIL-REGEXP (get-config 'email-regexp #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"))
+ (define EMAIL-DESC (get-config 'email-desc "a valid email address"))
(define ALLOW-NEW-USERS? (get-config 'allow-new-users #f))
(define MASTER-PASSWD (get-config 'master-password #f))
@@ -92,17 +94,8 @@
(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.
- (with-handlers ([void
- (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
+ (define (cleanup-submission-body)
+ ;; Find the newest SUCCESS dir -- ignore ATTEMPT, since if it exist it
;; means that there was a failed submission and the next one will
;; re-create ATTEMPT.
(let* ([dirlist (map path->string (directory-list))]
@@ -135,7 +128,20 @@
;; f is newer in dir than in the working directory
(delete-directory/files f)
(copy-directory/files dir/f f)]))
- (directory-list dir)))))))
+ (directory-list dir)))))
+
+ (define cleanup-sema (make-semaphore 1))
+ (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.
+ (with-handlers ([void
+ (lambda (e)
+ (LOG "*** ERROR DURING (cleanup-submission ~s) : ~a"
+ dir (if (exn? e) (exn-message e) e)))])
+ (parameterize ([current-directory dir])
+ (call-with-semaphore cleanup-sema cleanup-submission-body))))
(define (cleanup-all-submissions)
(LOG "Cleaning up all submission directories")
@@ -280,7 +286,8 @@
(string? passwd))
(error 'handin "bad user-addition request"))
(unless (regexp-match USER-REGEXP username)
- (error 'handin "bad username: \"~a\"" username))
+ (error 'handin "bad username: \"~a\"~a" username
+ (if USER-DESC (format "; need ~a" USER-DESC) "")))
;; Since we're going to use the username in paths:
(when (regexp-match #rx"[/\\:|\"<>]" username)
(error 'handin "username must not contain one of the following: / \\ : | \" < >"))
@@ -294,9 +301,11 @@
(when (string=? "checker.ss" username)
(error 'handin "the username \"checker.ss\" is reserved"))
(unless (regexp-match ID-REGEXP id)
- (error 'handin "id has wrong format: ~a; need ~a for id" id ID-DESC))
+ (error 'handin "id has wrong format: ~a~a" id
+ (if ID-DESC (format "; need ~a for id" ID-DESC) "")))
(unless (regexp-match EMAIL-REGEXP email)
- (error 'handin "email has wrong format: ~a" email))
+ (error 'handin "email has wrong format: ~a~a" email
+ (if EMAIL-DESC (format "; need ~a" EMAIL-DESC) "")))
(LOG "create user: ~a" username)
(put-user (string->symbol username)
(list (md5 passwd) id full-name email))
Please sign in to comment.
Something went wrong with that request. Please try again.