From e90cc72980014bb8e113033c38058ae26a6ed1b8 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Thu, 8 Oct 2009 22:18:50 +0200 Subject: Enable WSSE authentication. Ignore-this: a6ac88e1116f63a79ef8ccb4598b6280 darcs-hash:cc2c4916527d57c382cf2c342da04a7fd2b475ed --- utils.lisp | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'utils.lisp') 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 -- cgit v1.2.3