Suffix Handling.
Brendan Burns <[email protected]> Fri, 17 May 2002 12:18:31 -0400 (EDT)
| Newsgroups | gmane.lisp.open-source.franz |
|---|---|
| Message-ID | <[email protected]> |
Hey folks,
I added suffix handling to aserve: The following forms are added to
publish.cl:
(defclass locator-suffix (locator)
;; used to map suffixes to entites
()
(:default-initargs :info (make-hash-table :test #'equal))
)
(defmethod standard-locator ((req http-request)
(locator locator-suffix))
;; standard function for finding an entity in a suffix locator
;; return the entity if one is found, else return nil
(if* (uri-scheme (request-raw-uri req))
then ; ignore proxy requests
(return-from standard-locator nil))
(let* ((file (car (last (net.uri:uri-parsed-path (request-uri req)))))
(ix (last-index-of file ".")))
(if (= ix -1) nil
(let ((ents (gethash (subseq file ix)
(locator-info locator))))
(cdr
(or (assoc (request-vhost req) ents :test #'eq)
(assoc :wild ents :test #'eq)))))))
(defun index-of (seq subseq &key (index 0))
(let ((first (elt subseq 0)))
(loop for ix from index to (1- (length seq))
when (eql (elt seq ix) first)
do (if (equal subseq (subseq seq ix (+ ix (length subseq))))
(return-from index-of ix)))
-1))
(defun last-index-of (seq subseq &key (index -1))
(let ((first (elt subseq 0)))
(loop for ix from (if (= index -1) (1- (length seq)) index) downto 0
when (eql (elt seq ix) first)
do (if (equal subseq (subseq seq ix (+ ix (length subseq))))
(return-from last-index-of ix)))
-1))
(defun publish-suffix (&key (host nil host-p) port suffix
function class format
content-type
(server *wserver*)
locator
remove
authorizer
timeout
plist
)
;; publish a handler for all urls with a certain prefix
;;
(let (hval)
(if* (null locator)
then (setq locator (find-locator :suffix server)))
(setq hval (convert-to-vhosts (if* (and host (atom host))
then (list host)
else host)
server))
(if* remove
then ; eliminate the entity if it
exists
(publish-suffix-entity nil locator suffix hval)
nil
else
(let ((ent (make-instance (or class 'computed-entity)
:host hval
:port port
:prefix prefix
:function function
:format format
:content-type content-type
:authorizer authorizer
:plist plist
:timeout timeout)))
(publish-suffix-entity ent locator suffix hval)
ent))))
(defmethod publish-suffix-entity ((ent entity)
(locator locator-suffix)
suffix
hosts)
;; handle putting an entity in hash
;; table of a locator-exact.
;;
;; assert: hosts is a non-null list of vhosts
;;
(let ((ents (gethash suffix (locator-info locator))))
;; must replace entry with matching host parameter
(dolist (host hosts)
(let ((xent (assoc host ents :test #'eq)))
(if* (null xent)
then ; add new one
(push (cons host ent) ents)
else ; replace
(setf (cdr xent) ent))))
(setf (gethash suffix (locator-info locator)) ents)
ent))
Also the definition of the server has to be changed a little:
(defclass wserver
...
(locators
;; list of locators objects in search order
:initform (list (make-instance 'locator-exact
:name :exact)
(make-instance 'locator-prefix
:name :prefix)
(make-instance 'locator-suffix
:name :suffix))
...)
An example of how this is used would be:
(publish-suffix :suffix ".lsp"
:function (lambda (req ent)
(with-http-response (req ent)
(with-http-body (req ent)
(html (:html
(:body "Coming Soon")))))))
Thanks,
Brendan Burns