From b1393ddfe9b005021ece1e7df6f053861dcddc82 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 12:51:56 +0100 Subject: Loosen the core's dependency on Hunchentoot. --- mulkcms-hunchentoot.lisp | 33 +++++++++++++++++---- mulkcms.lisp | 77 +++++++++++++++++++++++++++++------------------- 2 files changed, 74 insertions(+), 36 deletions(-) mode change 100755 => 100644 mulkcms-hunchentoot.lisp diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp old mode 100755 new mode 100644 index c5fa908..762d181 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -17,11 +17,34 @@ (defun dispatch-mulkcms-request (request) (let* ((relative-path (subseq (script-name request) 1)) (mulkcms::*use-ssl-p* (equal (header-in* :x-use-ssl) - "true"))) - (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) + "true")) + (mulkcms::*real-remote-addr* + (hunchentoot:real-remote-addr)) + (mulkcms::*user-agent* + (hunchentoot:user-agent)) + (mulkcms::*request-method* + (hunchentoot:request-method*)) + (mulkcms::*headers* + (hunchentoot::headers-in*))) + (let ((result (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result))))) (defun setup-handlers () (setq *dispatch-table* diff --git a/mulkcms.lisp b/mulkcms.lisp index 97b5de3..dadefa9 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -8,6 +8,10 @@ (defvar *propagated-params*) (defvar *use-ssl-p*) (defvar *base-uri*) +(defvar *user-agent*) +(defvar *real-remote-addr*) +(defvar *request-method*) +(defvar *headers*) (unless (member "html-human-date" *template-formatters* :key #'car :test #'equal) (setq *template-formatters* @@ -136,15 +140,17 @@ (defun call-with-cache (path last-update content-type characteristics thunk) - (setf (hunchentoot:header-out :last-modified) - (hunchentoot:rfc-1123-date - (simple-date:timestamp-to-universal-time last-update))) - (when content-type - (setf (hunchentoot:content-type*) content-type)) - (when (eq (hunchentoot:request-method*) :post) + (when (eq *request-method* :post) (return-from call-with-cache - (funcall thunk))) - (when-let (date-string (hunchentoot:header-in* :if-modified-since)) + (let ((result (funcall thunk))) + (typecase result + (cons + (append (list :content-type content-type) + result)) + (t + (list :content-type content-type + :body result)))))) + (when-let (date-string (cdr (assoc :if-modified-since *headers*))) (when-let (if-modified-since (parse-http-date date-string)) ;; We need to subtract 1 second, since LAST-UPDATE will probably ;; have a non-zero millisecond part, which will make the @@ -155,8 +161,9 @@ last-update (simple-date:encode-interval :second 1)) if-modified-since) - (setf (hunchentoot:return-code*) hunchentoot:+http-not-modified+) - (hunchentoot:abort-request-handler)))) + (return-from call-with-cache + (list :return-code 304)) ;;304 Not Modified + ))) (let* ((chars characteristics) (charstring (format nil "~A; ssl=~A" (prin1-to-string chars) @@ -177,22 +184,26 @@ charhashnum path :row))) - (if (and cached-data (simple-date:time< last-update (second cached-data))) - (first cached-data) - (let ((generated-content (funcall thunk))) - (query "DELETE FROM cached_pages + (list :headers `((:last-modified . + ,(hunchentoot:rfc-1123-date + (simple-date:timestamp-to-universal-time last-update)))) + :content-type content-type + (if (and cached-data (simple-date:time< last-update (second cached-data))) + (first cached-data) + (let ((generated-content (funcall thunk))) + (query "DELETE FROM cached_pages WHERE characteristic_hash = $1 AND alias = $2" - charhashnum - path - :none) - (query "INSERT INTO cached_pages(characteristic_hash, alias, content) + charhashnum + path + :none) + (query "INSERT INTO cached_pages(characteristic_hash, alias, content) VALUES ($1, $2, $3)" - charhashnum - path - generated-content - :none) - generated-content)))) + charhashnum + path + generated-content + :none) + generated-content))))) (defmacro with-cache ((path last-update &optional content-type characteristics) @@ -565,7 +576,8 @@ "feed" "feed/" "journal/feed" "journal/feed") :test #'string=) - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p* *request-method* + *headers*) () (with-db (with-cache (path (query "SELECT max(date) FROM article_revisions" :single) @@ -1069,7 +1081,8 @@ :content-label "Content" :characteristics-label "Characteristics")))))))) (:view - (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () + (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p* *headers* + *real-remote-addr* *user-agent* *request-method*) () (with-db (with-cache (path (query "SELECT max(date) @@ -1109,8 +1122,8 @@ (not (hashcash-hash-validp (format nil "~A:~A:~A" body tkey salt)))) (spamp/akismet body name website - (hunchentoot:real-remote-addr) - (hunchentoot:user-agent))))) + *real-remote-addr* + *user-agent*)))) (with-transaction () (let ((comment (query "INSERT INTO comments(article, global_id) VALUES ($1, $2) @@ -1138,8 +1151,8 @@ "spam" "pending") revision - (hunchentoot:real-remote-addr) - (hunchentoot:user-agent) + *real-remote-addr* + *user-agent* :none) (setq submission-notice (cond @@ -1185,8 +1198,10 @@ (when (string= path "RPC/generate-transaction-key") (dynamic-lambda (*propagated-params* *base-uri* *use-ssl-p*) () (with-db - (setf (hunchentoot:content-type*) "text/plain; charset=utf-8") - (format nil "~D" (query "SELECT nextval('transaction_key_seq')" :single!)))))) + (list :content-type "text/plain; charset=utf-8" + :body (format nil "~D" + (query "SELECT nextval('transaction_key_seq')" + :single!))))))) (defun keywordify (thing) -- cgit v1.2.3 From d98707ce71f4695af30eeefa2d397c61cb24b8ae Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 12:52:48 +0100 Subject: Fix formatting. --- mulkcms.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mulkcms.lisp b/mulkcms.lisp index dadefa9..01e11cf 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -192,13 +192,13 @@ (first cached-data) (let ((generated-content (funcall thunk))) (query "DELETE FROM cached_pages - WHERE characteristic_hash = $1 - AND alias = $2" + WHERE characteristic_hash = $1 + AND alias = $2" charhashnum path :none) (query "INSERT INTO cached_pages(characteristic_hash, alias, content) - VALUES ($1, $2, $3)" + VALUES ($1, $2, $3)" charhashnum path generated-content -- cgit v1.2.3 From 7fb228efe3c58932bd465aedb8fa60f131523f87 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:25:37 +0100 Subject: Further decouple the core from Hunchentoot. --- mulkcms-hunchentoot.lisp | 48 +++++++++++++++++++++++----------------- mulkcms.lisp | 57 +++++++++++++++++++++++++----------------------- 2 files changed, 58 insertions(+), 47 deletions(-) diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 762d181..a2e5a15 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -14,6 +14,9 @@ (not (directory-pathname-p file)) (lambda () (handle-static-file file))))) +(defun handle-authorization-page () + (hunchentoot:require-authorization "MulkCMS")) + (defun dispatch-mulkcms-request (request) (let* ((relative-path (subseq (script-name request) 1)) (mulkcms::*use-ssl-p* (equal (header-in* :x-use-ssl) @@ -25,26 +28,31 @@ (mulkcms::*request-method* (hunchentoot:request-method*)) (mulkcms::*headers* - (hunchentoot::headers-in*))) - (let ((result (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result))))) + (hunchentoot::headers-in*)) + (mulkcms::*authorization-page-handler* + #'handle-authorization-page)) + (multiple-value-bind + (mulkcms::*user-name* mulkcms::*password*) + (hunchentoot:authorization) + (let ((result (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result)))))) (defun setup-handlers () (setq *dispatch-table* 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" -- cgit v1.2.3 From 102249de72f3e4b6f9fe0d8d2d71440dec68cf8e Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:29:15 +0100 Subject: Completely decouple the core from the Hunchentoot frontend by depending on local-time for HTTP date formatting. --- mulkcms.lisp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mulkcms.lisp b/mulkcms.lisp index 45fdac6..bf77bae 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -188,8 +188,10 @@ path :row))) (list :headers `((:last-modified . - ,(hunchentoot:rfc-1123-date - (simple-date:timestamp-to-universal-time last-update)))) + ,(local-time:format-timestring + nil + (simple-date:timestamp-to-universal-time last-update) + :format local-time:+rfc-1123-format+))) :content-type content-type (if (and cached-data (simple-date:time< last-update (second cached-data))) (first cached-data) -- cgit v1.2.3 From 0888c3fb04d2eb32af3e68df5ff31fcdb08cafed Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:34:48 +0100 Subject: Add dependency on local-time to system definition. --- mulkcms.asd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) mode change 100755 => 100644 mulkcms.asd diff --git a/mulkcms.asd b/mulkcms.asd old mode 100755 new mode 100644 index 84c2ba9..24ac416 --- a/mulkcms.asd +++ b/mulkcms.asd @@ -10,7 +10,8 @@ :version "0.0.1" :depends-on (:cl-who :cl-json :alexandria :postmodern :split-sequence :cl-ppcre :cl-fad :cxml :json-template :cxml-stp - :ironclad :flexi-streams :drakma :puri :simple-date) + :ironclad :flexi-streams :drakma :puri :simple-date + :local-time) :components ((:file "package") (:file "site") (:file "mulkcms") -- cgit v1.2.3 From cc294fe404c750acacca7385cd1d14572eeb6643 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:37:21 +0100 Subject: Fix frontend-decoupled authorization. --- mulkcms-hunchentoot.lisp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index a2e5a15..9f123d0 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -28,9 +28,7 @@ (mulkcms::*request-method* (hunchentoot:request-method*)) (mulkcms::*headers* - (hunchentoot::headers-in*)) - (mulkcms::*authorization-page-handler* - #'handle-authorization-page)) + (hunchentoot::headers-in*))) (multiple-value-bind (mulkcms::*user-name* mulkcms::*password*) (hunchentoot:authorization) @@ -73,5 +71,6 @@ (setq *acceptor* (make-instance 'hunchentoot:easy-acceptor :port *server-port* :address *server-address*)) + (setq mulkcms::*authorization-page-handler* #'handle-authorization-page) (hunchentoot:start *acceptor*)) -- cgit v1.2.3 From 7716246bac95b6fcaee683a25d227427f9b8b4d6 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:39:25 +0100 Subject: Fix the usage of local-time. --- mulkcms.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mulkcms.lisp b/mulkcms.lisp index bf77bae..2bea7c5 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -190,7 +190,8 @@ (list :headers `((:last-modified . ,(local-time:format-timestring nil - (simple-date:timestamp-to-universal-time last-update) + (local-time:universal-to-timestamp + (simple-date:timestamp-to-universal-time last-update)) :format local-time:+rfc-1123-format+))) :content-type content-type (if (and cached-data (simple-date:time< last-update (second cached-data))) -- cgit v1.2.3 From 2636502237938e0ed98ac2f872a85671ae94b8e3 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:42:12 +0100 Subject: Fix a typo. --- mulkcms.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/mulkcms.lisp b/mulkcms.lisp index 2bea7c5..f2c0292 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -194,6 +194,7 @@ (simple-date:timestamp-to-universal-time last-update)) :format local-time:+rfc-1123-format+))) :content-type content-type + :body (if (and cached-data (simple-date:time< last-update (second cached-data))) (first cached-data) (let ((generated-content (funcall thunk))) -- cgit v1.2.3 From 9522e35b0db9850796f5f995103c4d4e13cc23e3 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 22:34:59 +0100 Subject: Fix a small compilation order problem. --- mulkcms.lisp | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/mulkcms.lisp b/mulkcms.lisp index f2c0292..708f517 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -219,10 +219,6 @@ (lambda () ,@body))) -(defun invalidate-cache () - (with-db (query "DELETE FROM cached_pages"))) - - (defun find-canonical-article-alias (article) (query "SELECT alias FROM article_aliases WHERE article = $1 LIMIT 1" article @@ -293,6 +289,9 @@ (defmacro with-db (&body body) `(call-with-db (lambda () ,@body))) +(defun invalidate-cache () + (with-db (query "DELETE FROM cached_pages"))) + (defun find-template (template-name) (first (directory (make-pathname :name template-name :type :wild -- cgit v1.2.3 From 3b97d53de6b73b41d2153f74aa8c1961a75441ae Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 23:03:05 +0100 Subject: Actually make the decoupled design work. --- mulkcms-hunchentoot.lisp | 40 +++++++++++++++++++++------------------- mulkcms.lisp | 2 +- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 9f123d0..5a134ac 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -32,25 +32,27 @@ (multiple-value-bind (mulkcms::*user-name* mulkcms::*password*) (hunchentoot:authorization) - (let ((result (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result)))))) + (let ((handler (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (lambda () + (let ((result (funcall handler))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result)))))))) (defun setup-handlers () (setq *dispatch-table* diff --git a/mulkcms.lisp b/mulkcms.lisp index 708f517..e6a0b0b 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -2,7 +2,7 @@ (defparameter *database-connection-spec* (list *database-name* *database-user* *database-password* *database-host* - :pooled-p t :use-ssl :try)) + :pooled-p t :use-ssl :no)) (defvar *requested-characteristics*) (defvar *propagated-params*) -- cgit v1.2.3 From 12cdc3f219e948326fc6b5f428aca02b4b15c655 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 23:58:55 +0100 Subject: Fix static file handling. --- mulkcms-hunchentoot.lisp | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 5a134ac..4300871 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -36,23 +36,24 @@ (append (get-parameters*) (post-parameters*)) (header-in* :accept-language)))) - (lambda () - (let ((result (funcall handler))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result)))))))) + (and handler + (lambda () + (let ((result (funcall handler))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result))))))))) (defun setup-handlers () (setq *dispatch-table* -- cgit v1.2.3