diff options
| -rw-r--r-- | logikorr.lisp | 120 |
1 files changed, 68 insertions, 52 deletions
diff --git a/logikorr.lisp b/logikorr.lisp index e406007..d9f0098 100644 --- a/logikorr.lisp +++ b/logikorr.lisp @@ -19,6 +19,17 @@ (setq *hunchentoot-default-external-format* (flexi-streams:make-external-format :utf-8)) +(defmacro with-authentication (() &body body) + `(call-with-authentication (lambda () ,@body))) + +(defun call-with-authentication (thunk) + (multiple-value-bind (name password) + (authorization) + (if (and (string= name "test") (string= password "test")) + (funcall thunk) + (progn + (require-authorization "Logik-Ergebniseingabe"))))) + (defmacro with-data-lock (() &body body) `(call-with-data-lock (lambda () ,@body))) @@ -60,43 +71,46 @@ and do (incf id)))))) (define-easy-handler (show-main-page :uri "/") () - (let ((students (find-students))) - (ignore-errors (setf (header-out :content-type) "text/html; charset=UTF-8")) - (with-yaclml-output-to-string - (<:html - (<:head - (<:title "Logik I: Korrekturergebnisse") - (<:script :type "text/javascript" - :src "js/prototype.js") - (<:script :type "text/javascript" - :src "js/scriptaculous.js") - (<:link :type "text/css" :rel "stylesheet" :href "style.css") - (<:script :type "text/javascript" :src "http://yui.yahooapis.com/3.0.0/build/yui/yui-min.js") - (<:script :type "text/javascript" :src "logikorr.js") - (<:script :type "text/javascript" :src "logikorr-completion-data.js")) - (<:body - (<:h1 "Logik I: Korrekturergebnisse") - (<:h2 "Neue Ergebnisse") - (<:table :id "ergebnisse") - (<:h2 "Bestehende Ergebnisse") - (<:table - (<:tr - (<:th "ID") (<:th "Punkte") (<:th "Nachname") (<:th "Vorname")) - (dolist (student students) - (with-slots (id score last-name first-name) student - (<:tr (<:td (<:as-html id)) - (<:td (<:as-html score)) - (<:td (<:as-html last-name)) - (<:td (<:as-html first-name))))))))))) + (with-authentication () + (let ((students (find-students))) + (ignore-errors (setf (header-out :content-type) "text/html; charset=UTF-8")) + (with-yaclml-output-to-string + (<:html + (<:head + (<:title "Logik I: Korrekturergebnisse") + (<:script :type "text/javascript" + :src "js/prototype.js") + (<:script :type "text/javascript" + :src "js/scriptaculous.js") + (<:link :type "text/css" :rel "stylesheet" :href "style.css") + (<:script :type "text/javascript" :src "http://yui.yahooapis.com/3.0.0/build/yui/yui-min.js") + (<:script :type "text/javascript" :src "logikorr.js") + (<:script :type "text/javascript" :src "logikorr-completion-data.js")) + (<:body + (<:h1 "Logik I: Korrekturergebnisse") + (<:h2 "Neue Ergebnisse") + (<:table :id "ergebnisse") + (<:h2 "Bestehende Ergebnisse") + (<:table + (<:tr + (<:th "ID") (<:th "Punkte") (<:th "Nachname") (<:th "Vorname")) + (dolist (student students) + (with-slots (id score last-name first-name) student + (<:tr (<:td (<:as-html id)) + (<:td (<:as-html score)) + (<:td (<:as-html last-name)) + (<:td (<:as-html first-name)))))))))))) + (define-easy-handler (logikorr.js :uri "/logikorr.js") () (handle-static-file (relpath "logikorr.js"))) (define-easy-handler (logikorr-completion-data.js :uri "/logikorr-completion-data.js") () - (ignore-errors (setf (header-out :content-type) "text/javascript; charset=UTF-8")) - (format nil "~%autocompleteList = ~A" - (json:encode-json-to-string (mapcar (lambda (x) (unsplit-name (student-first-name x) (student-last-name x))) - (find-students))))) + (with-authentication () + (ignore-errors (setf (header-out :content-type) "text/javascript; charset=UTF-8")) + (format nil "~%autocompleteList = ~A" + (json:encode-json-to-string (mapcar (lambda (x) (unsplit-name (student-first-name x) (student-last-name x))) + (find-students)))))) (define-easy-handler (style.css :uri "/style.css") () @@ -177,29 +191,31 @@ div.autocomplete ul li { (find id (find-students) :key #'student-id)) (define-easy-handler (find-student :uri "/find-student") (name) - (let ((student (find-student-by-name name))) - (setf (header-out :content-type) "text/json; charset=UTF-8") - (with-slots (id first-name last-name score) student - (with-output-to-string (*standard-output*) - (json:encode-json-plist - (list :id id - :first-name first-name - :last-name last-name - :score score)))))) + (with-authentication () + (let ((student (find-student-by-name name))) + (setf (header-out :content-type) "text/json; charset=UTF-8") + (with-slots (id first-name last-name score) student + (with-output-to-string (*standard-output*) + (json:encode-json-plist + (list :id id + :first-name first-name + :last-name last-name + :score score))))))) (define-easy-handler (update-student-score :uri "/update-student-score") (id score-number score) - (with-data-lock () - (let ((student (find-student-by-id (parse-integer id))) - (index (parse-integer score-number))) - (loop while (<= (length (student-score student)) index) - do (vector-push-extend 0 (student-score student))) - (setf (elt (student-score student) index) - (let ((*read-eval* nil)) - (let ((score (read-from-string score))) - (check-type score number) - score)))) - (write-database)) + (with-authentication () + (with-data-lock () + (let ((student (find-student-by-id (parse-integer id))) + (index (parse-integer score-number))) + (loop while (<= (length (student-score student)) index) + do (vector-push-extend 0 (student-score student))) + (setf (elt (student-score student) index) + (let ((*read-eval* nil)) + (let ((score (read-from-string score))) + (check-type score number) + score)))) + (write-database))) "\"OK\"") (defun write-database () |