Enable WSSE authentication.

Ignore-this: a6ac88e1116f63a79ef8ccb4598b6280

darcs-hash:cc2c4916527d57c382cf2c342da04a7fd2b475ed

1 files changed, 32 insertions, 0 deletions

diff --git a/utils.lisp b/utils.lisp
index 574d9f2..57ebbe6 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -381,3 +381,35 @@ ELEMENT-TYPE as the stream's."
           (ext:quit 0))))
   #-clisp
     nil)
+
+
+(defun call-with-wsse-authentication (thunk)
+  (let ((params (list)))
+    (ppcre:do-scans (start end regstarts regends "(\\w+)=\"(.*?)\"" *wsse*)
+      (setf params (acons (subseq *wsse* (elt regstarts 0) (elt regends 0))
+                          (subseq *wsse* (elt regstarts 1) (elt regends 1))
+                          params)))
+    (let* ((timestamp (cdr (assoc "created" params :test 'equalp)))
+           (time (cybertiggyr-time:parse-time timestamp))
+           (nonce (cdr (assoc "nonce" params :test 'equalp)))
+           (user (cdr (assoc "username" params :test 'equalp)))
+           (their-digest (cdr (assoc "passworddigest" params :test 'equalp)))
+           (our-digest (cl-base64:string-to-base64-string
+                        (ironclad:digest-sequence
+                         'ironclad:sha1
+                         (format nil "~A~A~A" nonce timestamp *wsse-key*)))))
+      (declare (ignore user))
+      (if (and (string= their-digest our-digest)
+               (<= (abs (- (get-universal-time) time)) (* 5 60)))
+          (funcall thunk)
+          (progn
+            (http-add-header "Status" "401 Unauthorized")
+            (http-add-header "WWW-Authenticate" "WSSE realm=\"Mulk Journal\", profile=\"UsernameToken\"")
+            (http-add-header "X-Authentication-Message"
+                             (if (string= their-digest our-digest)
+                                 "Time stamp too old."
+                                 "Wrong user name or password.")))))))
+
+
+(defmacro with-wsse-authentication (() &body body)
+  `(call-with-wsse-authentication (lambda () ,@body)))
\ No newline at end of file