Hi,
I have implemented a handler for serving static files using TBNL. I ended up doing this differently than I expected. I extended create-prefix-dispatcher and called it create-prefix-dispatcher/2 and a little macro, prefix-dispatcher/2, to simplify things a bit. create-prefix-dispatcher/2 does everything that create-prefix-dispatcher does (in the same way) and is intended to be a drop-in replacement.
create-prefix-dispatcher/2 looks at its page-function argument and handles symbols exactly as create-prefix-dispatcher did, but cons are handled differently.
When create-prefix-dispatcher/2 encounters a page function that is a cons it assumes that it is a lambda with one argument that returns a lambda of no arguments. create-prefix-dispatcher/2 uses gensym to generate a symbol for the function then setfs its symbol-function to the lambda returned by (funcall (eval page-function) prefix). The generated symbol is then handled exactly as though that symbol was passed in as page-function. This seems a bit awkward to me, but it works.
The static-directory/*-handler takes 4 arguments: prefix -- the url prefix that matched the script-name. When this is removed from the front of the script-name, we are left with the path relative to the directory-path of the file requested. directory-path -- the root directory of the files to be served default-type -- the default mime-type (can be nil) file-type-map -- an assoc list of file name extensions (e.g. ".gif") and a mime type.
If the content-type cannot be determined it is not set (maybe not the best idea, but...)
I've not been able to test this on anything other that LWM using OS/X 10.3.9 -- so only tbnl-bivalent-streams has been tested at all.
Sorry, the documentation is a bit weak.
There is an example near the end of how to use this stuff.
Hope somebody finds this useful.
Cheers, Bob
-------
(defun static-directory/*-handler (prefix directory-path default-type file-type-map) "A TBNL handler that will serve static files located relative to a directory.
'prefix' is what TBNL matched to the script-name (this match provided the excuse to call this handler). If we remove the prefix from the front of the script-name we get the path, relative to 'directory-path', that identifies the file.
'default-type' is the default mime-type for the file, nil is okay.
'file-type-map' is an assoc list of file extensions and mime types. " (labels ((determine-content-type (relative-file-path) (or (cdr (find-if (lambda (pair) (zerop (mismatch (car pair) relative-file-path :from-end t))) file-type-map)) default-type))) (let* ((script-name (script-name)) (relative-file-path (subseq script-name (mismatch prefix script-name))) (path (concatenate 'string directory-path relative-file-path)) (time (or (file-write-date path) (get-universal-time))) (content-type (determine-content-type relative-file-path))) (when content-type (setf (content-type) content-type)) (unless (probe-file path) (setf (return-code) +http-not-found+) (throw 'tbnl-handler-done nil)) #+:tbnl-bivalent-streams (progn (handle-if-modified-since time) (with-open-file (file path :direction :input :element-type '(unsigned-byte 8) :if-does-not-exist nil) (let* ((len (file-length file)) (buf (make-array len :element-type '(unsigned-byte 8)))) (read-sequence buf file) (setf (header-out "Last-Modified") (rfc-1123-date time)) buf))) #-:tbnl-bivalent-streams (let ((buf (make-array 8192 :element-type 'character))) (handle-if-modified-since time) (let ((str (with-output-to-string (out) (with-open-file (file path :direction :input :if-does-not-exist nil) (loop for pos = (read-sequence buf file) until (zerop pos) do (write-sequence buf out :end pos)))))) (setf (header-out "Last-Modified") (rfc-1123-date time)) str)))))
(defmacro prefix-dispatcher/2 (fn &rest args) "construction a function with one argument, prefix, that returns a function of no arguments that calls fn with prefix as the first argument followed by the args." `(lambda (prefix) (lambda () (,fn prefix ,@args))))
(defun create-prefix-dispatcher/2 (prefix page-function) "Creates a dispatch function which will dispatch to the function denoted by PAGE-FUNCTION if the file name of the current request starts with the string PREFIX. This is exactly what create-prefix-dispatcher does. However, if page-function is a cons, then it must be of the form: (lambda (prefix) (lambda () ...)) This lambda serves as the page function."
(when (consp page-function) (let ((fn (gensym "handler")) (fv (funcall (eval page-function) prefix))) (setf (symbol-function fn) fv) (setf page-function fn))) (lambda (request) (let ((mismatch (mismatch (script-name request) prefix :test #'char=))) (and (or (null mismatch) (>= mismatch (length prefix))) page-function))))
(setq *dispatch-table* (nconc (mapcar (lambda (args) (apply #'create-prefix-dispatcher/2 args)) '(("/sienna/image/" (prefix-dispatcher/2 static-directory/*-handler "images/" nil '((".jpg" . "image/jpeg") (".jpeg" . "image/jpeg") (".gif" . "image/gif")))) ("/sienna/images/" (prefix-dispatcher/2 static-directory/*-handler "images/" nil '((".jpg" . "image/jpeg") (".jpeg" . "image/jpeg") (".gif" . "image/gif")))) ("/sienna/css/" (prefix-dispatcher/2 static-directory/*-handler "css/" nil '((".js" . "text/javascript") (".css" . "text/css") (".gif" . "image/gif")))) ("/sienna/item/" show-item))) (list #'default-dispatcher)))