suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

it is now possible to have hidden user fields

Browse Source 
svn: r1809
This commit is contained in:
Eli Barzilay 2006-01-12 00:21:45 +00:00
parent 7a0fc6091a
commit 3cd38a3d25
2 changed files with 48 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/handin-server/doc.txt
View File

@ -238,11 +238,11 @@ sub-directories:
add this configuration entry with the name of your new copy
(relative to the handin server directory)
'extra-fields : a list that describes extra fields of (string)
information for students; each element in this list is a list
of three values -- the name of the field, the regexp (or #f,
or a list of permitted string values), and a plain-words
description of acceptable strings. The default is
'extra-fields : a list that describes extra string fields of
information for student records; each element in this list is
a list of three values -- the name of the field, the regexp
(or #f, or a list of permitted string values), and a string
describing of acceptable strings. The default is
'(("Full Name" #f #f)
("ID#" #f #f)
@ -265,6 +265,17 @@ sub-directories:
The order of these fields will be used both on the client GUI
side and in the "users.ss" file (see below).
The second item in a field description can also be the symbol
'-, which marks this field as one that is hidden from the
user interface: students will not see it and will not be able
to provide or modify it; when a new student creates an
account, such fields will be left empty. This is useful for
adding information that you have on students from another
source, for example, adding information from a course roster.
You should manually edit the "users.ss" file and fill in such
information. (The third element for such descriptors is
ignored.)
* "users.ss" (created if not present if a user is added) --- keeps
the list of user accounts, along with the associated password
(actually the MD5 hash of the password), and extra string fields

44
collects/handin-server/handin-server.ss
View File

@ -70,6 +70,9 @@
("ID#" #f #f)
("Email" #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"
"a valid email address"))))
;; separate user-controlled fields, and hidden fields
(define USER-FIELDS
(filter (lambda (f) (not (eq? '- (cadr f)))) EXTRA-FIELDS))
(define orig-custodian (current-custodian))
@ -368,15 +371,26 @@
(regexp-match field-re value)]
[(list? field-re) (member value field-re)]
[(not field-re) #t]
[(eq? field-re '-) #t] ; -> hidden field, no check
[else (error 'handin "bad spec: field-regexp is ~e"
field-re)])
(error 'handin "bad ~a: \"~a\"~a" field-name value
(if field-desc (format "; need ~a" field-desc) ""))))
;; Utility for the next two functions: reconstruct a full list of
;; extra-fields from user-fields, using "" for hidden fields
(define (add-hidden-to-user-fields user-fields)
(let ([user-field-name->user-field (map cons USER-FIELDS user-fields)])
(map (lambda (f)
(cond [(assq f user-field-name->user-field) => cdr]
[else ""]))
EXTRA-FIELDS)))
(define (add-new-user data)
(define username (a-ref data 'username/s))
(define passwd (a-ref data 'password))
(define extra-fields (a-ref data 'extra-fields))
(define user-fields (a-ref data 'user-fields))
(define extra-fields (add-hidden-to-user-fields user-fields))
(unless ALLOW-NEW-USERS?
(error 'handin "new users not allowed: ~a" username))
(check-field username USER-REGEXP "username" USER-DESC)
@ -403,14 +417,16 @@
(put-user-data username (cons passwd extra-fields)))
(define (change-user-info data)
(define usernames (a-ref data 'usernames))
(define user-datas (a-ref data 'user-datas))
(define passwd (a-ref data 'new-password))
(define extra-fields (a-ref data 'extra-fields))
(define usernames (a-ref data 'usernames))
(define user-datas (a-ref data 'user-datas))
(define passwd (a-ref data 'new-password))
(define user-fields (a-ref data 'user-fields))
(define extra-fields (add-hidden-to-user-fields user-fields))
(unless (= 1 (length usernames))
(error 'handin "cannot change a password for multiple users: ~a"
usernames))
;; the new data is the same as the old one for every empty string
;; the new data is the same as the old one for every empty string (includes
;; hidden fields)
(let ([new-data (map (lambda (old new) (if (equal? "" new) old new))
(car user-datas) (cons passwd extra-fields))])
(unless (or ALLOW-CHANGE-INFO? (equal? (cdr new-data) (cdar user-datas)))
@ -420,14 +436,18 @@
(for-each
(lambda (str info) (check-field str (cadr info) (car info) (caddr info)))
(cdr new-data) EXTRA-FIELDS)
(LOG "change info for ~a ~s -> ~s" (car usernames) new-data (car user-datas))
(LOG "change info for ~a ~s -> ~s"
(car usernames) new-data (car user-datas))
(put-user-data (car usernames) new-data)))
(define (get-user-info data)
(define usernames (a-ref data 'usernames))
(unless (= 1 (length usernames))
(error 'handin "cannot get user-info for multiple users: ~a" usernames))
(cdar (a-ref data 'user-datas)))
;; filter out hidden fields
(let ([all-data (cdar (a-ref data 'user-datas))])
(filter values (map (lambda (d f) (and (memq f USER-FIELDS) d))
all-data EXTRA-FIELDS))))
(define crypt
(let ([c #f] [sema (make-semaphore 1)])
@ -468,9 +488,9 @@
[(set)
(let* ([key (read r-safe)] [val (read r-safe)])
(unless (symbol? key) (perror "bad key value: ~e" key))
(unless (if (eq? 'extra-fields key)
(unless (if (eq? 'user-fields key)
(and (list? val)
(- (length val) (length EXTRA-FIELDS))
(- (length val) (length USER-FIELDS))
(andmap string? val))
(string? val))
(perror "bad value for set: ~e" val))
@ -500,8 +520,8 @@
[(get-active-assignments)
(write+flush w active-assignments)
(loop)]
[(get-extra-fields)
(write+flush w EXTRA-FIELDS)
[(get-user-fields)
(write+flush w (map car USER-FIELDS))
(loop)]
;; ----------------------------------------
;; action handlers