Require authentication.

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 ()