summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-22 17:50:30 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-03-22 17:50:30 +0100
commit6e0a4a6753e1835e6639ad024425b79a7ce28856 (patch)
tree523e5802638bc5d95cb6fe9f50cc3ce032a3fc21
parent42f9eab207b449b24ecda0579b22b9a9a9b8a76e (diff)
Implement proper If-Modified-Since handling.
-rw-r--r--mulkcms.lisp75
1 files changed, 67 insertions, 8 deletions
diff --git a/mulkcms.lisp b/mulkcms.lisp
index c6c5419..e032db4 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -16,6 +16,11 @@
*template-formatters*)))
+(defparameter *month-abbreviations*
+ '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
+
+
(defun make-uuid ()
;; Taken from Mulkblog.
"Generate a version 4 UUID according to RFC 4122, section 4.4."
@@ -85,7 +90,66 @@
(string= "true" (apply #'akismet-check-comment comment-data)))))
+(defun parse-http-date (date-string)
+ (or (when-let (groups
+ ;; Match rfc1123-date (the whitespace stuff),
+ ;; rfc850-date (the hyphen stuff)
+ (nth-value
+ 1
+ (ppcre:scan-to-strings
+ "\\w+, (\\d+)[- ](\\w+)[- ](\\d+) (\\d+):(\\d+):(\\d+) GMT"
+ date-string)))
+ (simple-date:encode-timestamp
+ (let ((yr (parse-integer (elt groups 2))))
+ ;; Well. For the two-digit year version, I'm just going to
+ ;; assume a year >= 2000. If some clown client software
+ ;; thinks it needs to ask my server whether the site's
+ ;; content has changed since 1978 and does so using a
+ ;; two-digit year code, it deserves all the problems that
+ ;; this may cause it.
+ (if (>= yr 100)
+ yr
+ (+ 2000 yr)))
+ (1+ (position (elt groups 1) *month-abbreviations* :test #'equal))
+ (parse-integer (elt groups 0))
+ (parse-integer (elt groups 3))
+ (parse-integer (elt groups 4))
+ (parse-integer (elt groups 5))))
+ (when-let (groups
+ ;; Match asctime-date.
+ (nth-value
+ 1
+ (ppcre:scan-to-strings
+ "\\w+ (\\w+)\\s+(\\d+) (\\d+):(\\d+):(\\d+) (\\d+)"
+ date-string)))
+ (simple-date:encode-timestamp
+ (parse-integer (elt groups 5))
+ (1+ (position (elt groups 1) *month-abbreviations* :test #'equal))
+ (parse-integer (elt groups 0))
+ (parse-integer (elt groups 2))
+ (parse-integer (elt groups 3))
+ (parse-integer (elt groups 4))))))
+
+
(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-let (date-string (hunchentoot:header-in* :if-modified-since))
+ (when-let (if-modified-since (parse-http-date date-string))
+ (print last-update)
+ (print if-modified-since)
+ ;; We need to subtract 1 second, since LAST-UPDATE will probably
+ ;; have a non-zero millisecond part, which will make the
+ ;; comparison fail in the very common case that the
+ ;; If-Modified-Since time is exactly what we previously sent as
+ ;; the Last-Modified header (which didn't include milliseconds).
+ (when (simple-date:time<= (simple-date:time-subtract
+ last-update
+ (simple-date:encode-interval :second 1))
+ if-modified-since)
+ (setf (hunchentoot:return-code*) hunchentoot:+http-not-modified+)
+ (hunchentoot:abort-request-handler))))
(let* ((chars characteristics)
(charstring (prin1-to-string chars))
(charbytes (flexi-streams:string-to-octets
@@ -101,14 +165,9 @@
FROM cached_pages
WHERE characteristic_hash = $1
AND alias = $2"
- charhashnum
- path
- :row)))
- (hunchentoot:handle-if-modified-since
- (simple-date:timestamp-to-universal-time last-update))
- (setf (hunchentoot:header-out :last-modified)
- (hunchentoot:rfc-1123-date
- (simple-date:timestamp-to-universal-time last-update)))
+ charhashnum
+ path
+ :row)))
(when content-type
(setf (hunchentoot:content-type*) content-type))
(if (and cached-data (simple-date:time< last-update (second cached-data)))