summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2009-11-22 09:20:41 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2009-11-22 09:20:41 +0100
commit226ca14e2a7c26320f507e614319d44ea26ffb68 (patch)
tree6d7ad411b5925476d66a7c0925851f6c80a542a2
parent46ba2c597c07670767ef7cf179467b1d9b389808 (diff)
Require authentication.
-rw-r--r--logikorr.lisp120
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 ()