diff options
Diffstat (limited to 'mulkcms.lisp')
| -rw-r--r-- | mulkcms.lisp | 57 |
1 files changed, 30 insertions, 27 deletions
diff --git a/mulkcms.lisp b/mulkcms.lisp index 01e11cf..45fdac6 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -12,6 +12,9 @@ (defvar *real-remote-addr*) (defvar *request-method*) (defvar *headers*) +(defvar *user-name*) +(defvar *password*) +(defvar *authorization-page-handler*) (unless (member "html-human-date" *template-formatters* :key #'car :test #'equal) (setq *template-formatters* @@ -577,7 +580,7 @@ "journal/feed" "journal/feed") :test #'string=) (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p* *request-method* - *headers*) () + *headers* *user-name* *password*) () (with-db (with-cache (path (query "SELECT max(date) FROM article_revisions" :single) @@ -761,27 +764,25 @@ ,@options)) (defun call-with-authorization (thunk &key require) - (multiple-value-bind (user-name password) - (hunchentoot:authorization) - (with-db - (let ((user-id (query (format nil - "SELECT id - FROM users u - JOIN passwords p ON u.id = p.user - WHERE p.password = $2 - AND u.name = $1 - AND ~A" - (ecase require - ((nil) "true") - ((:admin) "u.status = 'admin'") - ((:trusted) "u.status IN ('trusted', 'admin')") - ((:approved) "u.status IN ('approved', 'trusted', 'admin')"))) - user-name - password - :single))) - (if user-id - (funcall thunk user-id) - (hunchentoot:require-authorization "MulkCMS")))))) + (with-db + (let ((user-id (query (format nil + "SELECT id + FROM users u + JOIN passwords p ON u.id = p.user + WHERE p.password = $2 + AND u.name = $1 + AND ~A" + (ecase require + ((nil) "true") + ((:admin) "u.status = 'admin'") + ((:trusted) "u.status IN ('trusted', 'admin')") + ((:approved) "u.status IN ('approved', 'trusted', 'admin')"))) + *user-name* + *password* + :single))) + (if user-id + (funcall thunk user-id) + (funcall *authorization-page-handler*))))) (defun parse-row-or-array (string) (let ((output (list))) @@ -829,7 +830,8 @@ *requested-characteristics*)) (declare (ignore characteristics action)) (when (string= path "admin/comments") - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*user-name* *password* *propagated-params* *base-uri* + *use-ssl-p*) () (with-authorization (user-id :require :admin) (declare (ignore user-id)) (with-db @@ -877,7 +879,7 @@ *requested-characteristics*)) (declare (ignore characteristics action)) (when (string= path "admin/articles") - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*user-name* *password* *propagated-params* *base-uri* *use-ssl-p*) () (with-authorization (user-id :require :admin) (with-db (labels ((paramify-revision-row (row article-id) @@ -982,7 +984,7 @@ :single))) (ecase action (:edit - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*user-name* *password* *propagated-params* *base-uri* *use-ssl-p*) () (with-authorization (user-id :require :admin) (with-db (with-transaction () @@ -1082,7 +1084,8 @@ :characteristics-label "Characteristics")))))))) (:view (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p* *headers* - *real-remote-addr* *user-agent* *request-method*) () + *real-remote-addr* *user-agent* *request-method* + *user-name* *password*) () (with-db (with-cache (path (query "SELECT max(date) @@ -1196,7 +1199,7 @@ (defun find-transaction-key-handler (path) (when (string= path "RPC/generate-transaction-key") - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*user-name* *password* *propagated-params* *base-uri* *use-ssl-p*) () (with-db (list :content-type "text/plain; charset=utf-8" :body (format nil "~D" |