diff options
| -rw-r--r--[-rwxr-xr-x] | mulkcms-hunchentoot.lisp | 33 | ||||
| -rw-r--r-- | mulkcms.lisp | 77 |
2 files changed, 74 insertions, 36 deletions
diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index c5fa908..762d181 100755..100644 --- 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) |