new-user lock, more username restrictions

svn: r817
This commit is contained in:
Matthew Flatt 2005-09-09 20:43:29 +00:00
parent 46dfd90701
commit adec0ec106
2 changed files with 58 additions and 42 deletions

View File

@ -100,11 +100,11 @@ To customize the client:
* For `name', choose a name for the handin tool as it will
appear in DrScheme's interface (e.g., the "XXX" for the
"Manage XXX..." menu item). Again, make the name specific to
the course, in case a student installs multiple handin tools.
It's a good idea to use "Handin" as the last part of the
name, as in "2010 Handin", since the button is always named
"Handin".
"Manage XXX Account..." menu item). Again, make the name
specific to the course, in case a student installs multiple
handin tools. It's a good idea to use "Handin" as the last
part of the name, as in "2010 Handin", since the button is
always named "Handin".
* For `collection', use the name that you chose for your
collection directory (i.e., whatever you changed
@ -196,26 +196,25 @@ sub-directories:
"BACKUP-1/handin.scm", etc.; the default is 9
'user-regexp : a regular expression that is used to validate
usernames, young students often choose exotic usernames that
are impossible to remember, and forget capitalization; the
default is fairly strict: #rx"^[a-z][a-z0-9]+$"
usernames, young students often choose exotic usernames that
are impossible to remember, and forget capitalization; the
default is fairly strict: #rx"^[a-z][a-z0-9]+$"
'username-case-sensitive? : a boolean flag, when #f, usernames
are normalized to lower case for all messages; defaults to #f
'username-case-sensitive? : a boolean; when #f, usernames
are case-folded for all purposes; defaults to #f
'id-regexp : a regular expression that is used to validate a
"free form" user id (possibly a student id) for a created
account; the
default is #rx"^.*$"
"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"
'email-regexp : a regular expression that is used to validate
emails, the #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"
default can be changed to "" if you don't care about emails,
or can be further restricted, for example requiring a
"@cs.foo.edu" suffix
emails, the #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"
default can be changed to "" if you don't care about emails,
or can be further restricted, for example requiring a
"@cs.foo.edu" suffix
'allow-new-users : a boolean indicating whether to allow
new-user requests from a client tool; the default is #f
@ -225,12 +224,12 @@ sub-directories:
the password
'web-base-dir : if #f (the default), the built-in web server
will use the "status-web-root" in this collection for its
configuration; to have complete control over the built in
server, you can copy and edit "status-web-root" to the
directory you're running the handin server server from, and
add this configuration entry with the name of your new copy
(relative to the handin server directory).
will use the "status-web-root" in this collection for its
configuration; to have complete control over the built in
server, you can copy and edit "status-web-root" to the
directory you're running the handin server server from, and
add this configuration entry with the name of your new copy
(relative to the handin server directory)
* "users.ss" (created if not present if a user is added) --- keeps
the list of user accounts, along with the associated password
@ -246,7 +245,10 @@ sub-directories:
can always be updated by the server to change passwords.
The username "solution" is special. It is used by the HTTPS status
server.
server. Independent of the 'user-regexp and 'username-case-sensitive?
configration items, usernames are not allowed to contain characters
that are illegal in Windows pathnames, they cannot end in spaces
or periods, and no to user ids can have the same case folding.
* "active/" --- sub-directory for active assignments. A list of
active assignments is sent to a client tool when a student clicks

View File

@ -124,15 +124,16 @@
;; On startup, we scan *all* submissions
(LOG "Cleaning up submission directories")
(for-each (lambda (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))))
(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"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -243,15 +244,19 @@
(string? passwd))
(error 'handin "bad user-addition request"))
(unless (regexp-match USER-REGEXP username)
(error 'handin "bad user name: \"~a\"" username))
(error 'handin "bad username: \"~a\"" username))
;; Since we're going to use the username in paths:
(when (regexp-match #rx"[/\\:]" username)
(error 'handin "username must not contain a slash, backslash, or colon"))
(when (regexp-match #rx"^((NUL)|(CON)|(PRN)|(AUX)|(CLOCK[$])|(COM[1-9])|(LPT[1-9]))[.]?"
(list->string (map char-upcase (string->list username))))
(when (regexp-match #rx"[/\\:|\"<>]" username)
(error 'handin "username must not contain one of the following: / \\ : | \" < >"))
(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 (string=? "solution" username)
(error 'handin "the username \"solution\" is reserved"))
(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))
(unless (regexp-match EMAIL-REGEXP email)
@ -280,9 +285,9 @@
(and (string? s)
(if USERNAME-CASE-SENSITIVE?
s
(let ([s (string-copy s)]) (string-lowercase! s) s))))]
(string-foldcase s))))]
[usernames
;; User name lists must always be sorted
;; Username lists must always be sorted
(if user-string
(quicksort (regexp-split #rx" *[+] *" user-string) string<?)
'())]
@ -293,14 +298,23 @@
[passwd (read r-safe)])
(cond
[(eq? passwd 'create)
(wait-for-lock "+newuser+")
(unless ALLOW-NEW-USERS?
(error 'handin "new users not allowed: ~a" user-string))
(unless (= 1 (length usernames))
(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 (car user-datas)
(error 'handin "username already exists: `~a'" 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))
(add-new-user user-string r-safe w)]
[(and (pair? user-datas)
(not (memq #f user-datas))