Tuesday, 29 May 2007

Hunchentoot and packages

Over the past couple of years I've been experimenting with a number of CL
http servers and have recently turned to hunchentoot as my platform of choice
which, like the rest of Edi's packages, has found it's way into my heart.

One of the things I've often found rather annoying however (not with
Hunchentoot specifically, this is present in all of the CL web servers
I've experimented with) is that publishing a URL is a twofold process:

a) define your handler function (or something similar) and
b) register that handler with a particular URL.

Now all this becomes a little repetitive so here is a new publisher function
which allows you to publish your package on a particular URL so that any
requests to URL's 'below' that one will be resolved to a function in your package.

We play on one of the less remarked upon CL features (or lack of restrictions)
which allows symbols to start with a #\/ (a forward slash, to those not used to
the CL character macro reader) so we can publish our package on /test define a
function named /foo and automagically have requests to /test/foo mapped
to our /foo handler.

(modified 30/5/2007 16:00)

(asdf:oos 'asdf:load-op :hunchentoot)
(asdf:oos 'asdf:load-op :cl-who)

(defpackage :pack-test (:use :cl :hunchentoot :cl-who))
(in-package :pack-test)

(defun index ()
#'(lambda ()
(with-html-output-to-string (x)
(:html "The index page"))))

(defun seq-last (seq)
(aref seq (1- (length seq))))

(defun string->handler (string package)
(when (string= string "/") (return-from string->handler (index)))
(multiple-value-bind (sym type) (find-symbol string package)
(when (and (not (eql type :inherited))
(fboundp sym))
(symbol-function sym))))

(defun create-package-dispatcher (prefix)
(check-type prefix string)
(assert (eql (seq-last prefix) #\/) (prefix) "Prefix must end in a / (forward slash)")
#'(lambda (request)
(let* ((function (script-name request))
(mismatch (mismatch (script-name request) prefix
:test #'char=)))
(when (or (null mismatch)
(>= mismatch (length prefix)))
(string->handler (string-upcase (subseq function (1- (length prefix))))

(push (create-package-dispatcher "/test/") *dispatch-table*)

(defun /index ()
(with-html-output-to-string (out)
(:html (:head (:title "Welcome"))
(:body (:h2 "This is my welcome page")))))

(defvar *server* (start-server :port 8080))

and now browsing to http://localhost:8080/test/index should give you a
nice new welcome page and adding a new URL is a simple 1 step process.

This post is courtesy of lispworks(5.0.2), hunchentoot(0.9.2) and cl-who (0.4.4)


Bruce -- said...

What about symbols that find-symbol finds that aren't functions? Or that might be inappropriate, like CL:/=?

Bruce -- said...

Why are the lines in your post so short?

okflo said...

i posted once a (poorly documented) similar solution using something like (defweb "/my/url") on the tbnl-mailinglist. Is also handles parametes as kind of function-parameters (defweb* "/my/url" (par1 par2)) see: http://article.gmane.org/gmane.lisp.lib.tbnl.general/707/

Vagif Verdi said...

I'm confused.
hunchentoot already has define-easy-handler
How is this different ?

Sean Ross said...

bruce: This works on the assumption that functions starting with a / are to be published. Good catch with /= though, I completely forgot about that one. Excluding :inherited symbols would probably be a good choice and would solve that particular problem.

Sean Ross said...

vagif: thanks for the pointer, I completely missed define-easy-handler .

Edi Weitz said...

SEARCH is not good enough to test for a prefix - you could find a substring in the middle of the string.

Sean Ross said...

Edi: cough, cough. Thanks I'll patch it up.

Bruce -- said...

But it's not just functions that will turn up with find-symbol. You'll find any symbol in the package, including scratch symbols that you used for other stuff or that appeared as variables or other tokens in source code...

Sean Ross said...

Thanks to all for the comments.
The code has now been updated.