[tbnl-devel] Patch for handling If-Modified-Since

[Stefan Scholl]

Hi!

A patch for handling If-Modified-Since is attached to this
e-mail. Maybe it could be useful.

I've only tested it with Mozilla 1.7.1 (with help from
<http://livehttpheaders.mozdev.org/>). So additional tests would
be fine.


New function rfc1123-date for generating a date string for http
headers.

Function handle-if-modified-since wants a time and handles almost
everything by itself. Checks against If-Modified-Since and
returns a 304 return code if necessary.

You have to set the Last-Modified header by yourself because you
don't know if you can produce some output at this point. See
create-static-file-dispatcher-and-handler in html.lisp for an
example.

I've improved create-static-file-dispatcher-and-handler by adding
cache functionality with handle-if-modified-since and setting
Last-Modified, and a simple check if the file exists. (==> 404 if
not). You see that Last-Modified isn't set when the file doesn't
exist.


Regards,
Stefan
-------------- next part --------------
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.2.5/html.lisp tbnl-0.2.5-stesch/html.lisp
--- tbnl-0.2.5/html.lisp	2004-07-21 00:58:28.000000000 +0200
+++ tbnl-0.2.5-stesch/html.lisp	2004-07-22 17:40:42.000000000 +0200
@@ -141,12 +141,22 @@
       (when (equal (script-name request) uri)
         ;; the handler
         (lambda ()
-          (setf (content-type) content-type)
-          (with-output-to-string (out)
-            (with-open-file (file path
-                                  :direction :input
-                                  #+:tbnl-bivalent-streams :element-type
-                                  #+:tbnl-bivalent-streams '(unsigned-byte 8))
-              (loop for pos = (read-sequence buf file)
-                    until (zerop pos)
-                    do (write-sequence buf out :end pos)))))))))
\ No newline at end of file
+          (let ((time (or (file-write-date path)
+                          (get-universal-time))))
+            (handle-if-modified-since time)
+            (setf (content-type) content-type)
+            (let ((str
+                   (with-output-to-string (out)
+                     (with-open-file (file path
+                                           :direction :input
+                                           #+:tbnl-bivalent-streams :element-type
+                                           #+:tbnl-bivalent-streams '(unsigned-byte 8)
+                                           :if-does-not-exist nil)
+                       (unless file     ; does not exist
+                         (setf (return-code) +http-not-found+)
+                         (throw 'tbnl-handler-done nil))
+                       (loop for pos = (read-sequence buf file)
+                             until (zerop pos)
+                             do (write-sequence buf out :end pos))))))
+              (setf (header-out "Last-Modified") (rfc1123-date time))
+              str)))))))
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.2.5/request.lisp tbnl-0.2.5-stesch/request.lisp
--- tbnl-0.2.5/request.lisp	2004-05-07 16:10:40.000000000 +0200
+++ tbnl-0.2.5-stesch/request.lisp	2004-07-22 17:01:53.000000000 +0200
@@ -261,3 +261,13 @@
 returned. Search is case-sensitive."
   (or (get-parameter name request)
       (post-parameter name request)))
+
+(defun handle-if-modified-since (time &optional (request *request*))
+  "Handles the If-Modified-Since header of the REQUEST. Date string is
+compared to the one generated from the supplied TIME."
+  (let ((if-modified-since (header-in "If-Modified-Since" request))
+        (time-string (rfc1123-date time)))
+    ;; Simple string compare is sufficient. See RFC 2616 14.25
+    (when (and if-modified-since (equal if-modified-since time-string))
+      (setf (return-code) +http-not-modified+)
+      (throw 'tbnl-handler-done nil))))
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.2.5/specials.lisp tbnl-0.2.5-stesch/specials.lisp
--- tbnl-0.2.5/specials.lisp	2004-07-19 14:22:09.000000000 +0200
+++ tbnl-0.2.5-stesch/specials.lisp	2004-07-22 15:37:29.000000000 +0200
@@ -46,6 +46,7 @@
 (defconstant +http-ok+ 200)
 (defconstant +http-moved-permanently+ 301)
 (defconstant +http-moved-temporarily+ 302)
+(defconstant +http-not-modified+ 304)
 (defconstant +http-authorization-required+ 401)
 (defconstant +http-forbidden+ 403)
 (defconstant +http-not-found+ 404)
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.2.5/tbnl.asd tbnl-0.2.5-stesch/tbnl.asd
--- tbnl-0.2.5/tbnl.asd	2004-05-12 19:05:09.000000000 +0200
+++ tbnl-0.2.5-stesch/tbnl.asd	2004-07-22 16:56:19.000000000 +0200
@@ -41,7 +41,7 @@
                  (:file "util" :depends-on ("specials"))
                  (:file "log" :depends-on ("util"))
                  (:file "cookie" :depends-on ("util"))
-                 (:file "request" :depends-on ("util"))
+                 (:file "request" :depends-on ("util" "reply" "specials"))
                  (:file "reply" :depends-on ("util"))
                  (:file "session" :depends-on ("cookie" "log"))
                  (:file "html" :depends-on ("session" "request" "util"))
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.2.5/util.lisp tbnl-0.2.5-stesch/util.lisp
--- tbnl-0.2.5/util.lisp	2004-07-19 14:22:09.000000000 +0200
+++ tbnl-0.2.5-stesch/util.lisp	2004-07-22 16:38:42.000000000 +0200
@@ -66,6 +66,7 @@
     ((#.+http-ok+) "OK")
     ((#.+http-moved-permanently+) "Moved Permanently")
     ((#.+http-moved-temporarily+) "Moved Temporarily")
+    ((#.+http-not-modified+) "Not Modified")
     ((#.+http-authorization-required+) "Authorization Required")
     ((#.+http-forbidden+) "Forbidden")
     ((#.+http-not-found+) "Not Found")
@@ -210,4 +211,18 @@
 (defun get-backtrace (error)
   (declare (ignore error))
   (format nil "Output of backtrace currently not implemented for ~A"
-          (lisp-implementation-type)))
\ No newline at end of file
+          (lisp-implementation-type)))
+
+(defun rfc1123-date (&optional (time (get-universal-time)))
+  "Generate time string according to RFC 1123. Default is current time."
+  (multiple-value-bind
+        (second minute hour date month year day-of-week)
+      (decode-universal-time time 0)
+    (format nil "~A, ~2d ~A ~4d ~2,'0d:~2,'0d:~2,'0d GMT"
+            (svref +day-names+ day-of-week)
+            date
+            (svref +month-names+ (1- month))
+            year
+            hour
+            minute
+            second)))