diff --git a/.gitignore b/.gitignore index 38a4087..f15f789 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ compiled/ *~ +\#* diff --git a/handin-server/checker.rkt b/handin-server/checker.rkt index 1de984e..581f861 100644 --- a/handin-server/checker.rkt +++ b/handin-server/checker.rkt @@ -770,3 +770,8 @@ ((if (pair? proc) (car proc) handler) loc)))] [(null? uncovered) #f] [else (error* "bad checker: no coverage information for !all-covered")])) + +(module reader syntax/module-reader + handin-server/checker + #:read read + #:read-syntax read-syntax) diff --git a/handin-server/main.rkt b/handin-server/main.rkt index 8c93819..961a52b 100644 --- a/handin-server/main.rkt +++ b/handin-server/main.rkt @@ -4,6 +4,7 @@ racket/port openssl racket/file + racket/string "private/logger.rkt" "private/config.rkt" "private/lock.rkt" @@ -418,12 +419,15 @@ (define extra-fields (add-hidden-to-user-fields user-fields)) (unless (= 1 (length usernames)) (error* "cannot change a password for multiple users: ~a" usernames)) + (unless (or (string? passwd) + (= 1 (length passwd))) + (error* "cannot change a password for multiple users: ~a" usernames)) ;; the new data is the same as the old one for every empty string (includes ;; hidden fields) (let* ([username (car usernames)] [old-data (car user-datas)] [new-data (map (lambda (old new) (if (equal? "" new) old new)) - old-data (cons passwd extra-fields))]) + old-data (cons (car passwd) extra-fields))]) (unless (or (get-conf 'allow-change-info) (equal? (cdr new-data) (cdr old-data))) (error* "changing information not allowed: ~a" username)) @@ -477,6 +481,13 @@ (or (member md5 passwords) ; very cheap search first (ormap good? passwords))) +(define (has-password?/check-all raw md5 master passwords) + (for/fold ([good? #t]) + ([r (in-list raw)] + [m (in-list md5)] + [p (in-list passwords)]) + (and good? (has-password? r m (if master (list master p) (list p)))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (handle-connection r r-safe w) @@ -485,6 +496,11 @@ (define data (make-alist 'protocol-data `((assignments . ,(box active-assignments))))) (define (perror fmt . args) (apply error 'handin-protocol fmt args)) + (define group-auth (get-conf 'group-authentication)) + (define only-create/update? #f) + (unless (or (eq? 'single group-auth) + (eq? 'multi group-auth)) + (error "Invalid group-authentication configuration: ~a" group-auth)) (let loop () (set! msg (read r-safe)) (case msg @@ -492,29 +508,61 @@ ;; getting information from the client [(set) (let* ([key (read r-safe)] [val (read r-safe)]) + (define user-count #f) (unless (symbol? key) (perror "bad key value: ~e" key)) - (unless (if (eq? 'user-fields key) - (and (list? val) - (- (length val) (length (get-conf 'user-fields))) - (andmap string? val)) - (string? val)) + (unless (cond + [(eq? 'user-fields key) + (and (list? val) + (- (length val) (length (get-conf 'user-fields))) + (andmap string? val))] + [(and (eq? 'multi group-auth) + (or (eq? 'username/s key) + (eq? 'password key) + (eq? 'new-password key))) + (if (string? val) + (let () + (set! group-auth 'single) + (set! only-create/update? #t)) + (and (list? val) + (if user-count + (eq? user-count (length val)) + (set! user-count (length val))) + (andmap string? val)))] + [else (string? val)]) (perror "bad value for set: ~e" val)) (when (a-ref data key #f) (perror "multiple values for ~e" key)) (case key [(username/s) (unless (get-conf 'username-case-sensitive) (set! val (string-foldcase val))) - (let ([usernames - ;; Username lists must always be sorted, and never empty - ;; (regexp-split will not return an empty list) - (sort (regexp-split #rx" *[+] *" val) string