diff options
Diffstat (limited to 'lazybones-hunchentoot.lisp')
| -rw-r--r-- | lazybones-hunchentoot.lisp | 124 |
1 files changed, 81 insertions, 43 deletions
diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp index fd437e0..9c2d108 100644 --- a/lazybones-hunchentoot.lisp +++ b/lazybones-hunchentoot.lisp @@ -8,6 +8,73 @@ (in-package :lazybones.backend/hunchentoot) +;;; Hunchentoot Acceptor Subclass + +(defvar %server nil + "unexported defvar holding the lazybones-acceptor instance.") + +(defclass lazybones-acceptor (h:acceptor) + ((installed-apps + :accessor acceptor-apps + :initform nil + :documentation "Instances of LAZYBONES:APP installed to this + acceptor. APPs are, among other things, collections of ENDPOINT + instances. The acceptor instance uses them to dispatch handlers + on requests.") + (canned-responses + :accessor canned-responses + :initarg :canned-responses + :initform nil + :documentation "an alist of (CODE CONTENT-FUNCTION CONTENT-TYPE)")) + (:default-initargs + :address "127.0.0.1")) + +(defmethod h:acceptor-dispatch-request ((%server lazybones-acceptor) request) + (loop for app in (acceptor-apps %server) + for (endpoint . args) = (lzb::find-endpoint app request) + when endpoint + return (lzb::run-endpoint endpoint args request h:*reply* app) + ;; if no endpoint was found, call next method. + finally (call-next-method))) + +;;; SERVER FUNCTIONS + +(defun create-server (&key (port 8888) (address "127.0.0.1")) + "Creates an opaque server on port PORT, and returns it. Servers are +backend specific, but each may be passed in to INSTALL-APP, +UNINSTALL-APP, START-SERVER, and STOP-SERVER." + (make-instance 'lazybones-acceptor :port port :address address)) + +(defun start-server (server) + (h:start server)) + +(defun stop-server (server) + (h:stop server)) + +(defun install-app (server app) + "Installs a LAZYBONES:APP instance to SERVER." + ;; TODO add assertsion here + (push (if (symbolp app) (lzb:app app) app) (acceptor-apps server))) + +(defun uninstall-app (server app) + (setf (acceptor-apps server) + (delete (if (symbolp app) (lzb:app app) app) (acceptor-apps server)))) + +(defun canned-response (server code) + "If a canned response is installed to the server for the HTTP +response code CODE, return it as a list (RESPONSE-SOURCE CONTENT-TYPE). + +RESPONSE-SOURCE is either a function designator for a function taking +zero arguments that is expected to return data that matches the +CONTENT-TYPE. Such a function can always make use of *REQUEST*. + +RESPONSE-SOURCE can also be a pathname to a file to serve." + (cdr (assoc code (canned-responses server)))) + +(defun set-canned-response (server code content-source content-type) + "Set a new canned response for the code CODE." + (push (list code content-source content-type) (canned-responses server))) + ;;; HTTP REQUEST FUNCTIONS (defun request-path (&optional (request lzb:*request* )) @@ -145,6 +212,20 @@ the value of the Content-Type request header." Hunchentoot, set the response code and a few headers. If content is a pathname, pass off to HUNCHENTOOT:HANDLE-STATIC-FILE, otherwise just return the content." + + ;; When http-err is called, the content is likely to be null. If + ;; that is the case, look for the default content for the error + ;; code, and set content and content-type appropriately + (a:when-let (data + (and (null content) + (canned-response %server code))) + (destructuring-bind (source content-type) data + (setf (response-header :content-type) content-type + content (if (or (functionp source) (symbolp source)) + (funcall source) + source)))) + + ;; set the response code and header. (setf (response-code) code (response-header :content-type) (or (response-header :content-type) (when (pathnamep content) @@ -155,46 +236,3 @@ return the content." (h:handle-static-file content) content)) -;;; LIFECYCLE FUNCTIONS - -(defun create-server (port) - "Creates an opaque server on port PORT, and returns it. Servers are -backend specific, but each may be passed in to INSTALL-APP, -UNINSTALL-APP, START-SERVER, and STOP-SERVER." - (make-instance 'lazybones-acceptor :port port)) - -(defun start-server (server) - (h:start server)) - -(defun stop-server (server) - (h:stop server)) - -(defun install-app (server app) - "Installs a LAZYBONES:APP instance to SERVER." - ;; TODO add assertsion here - (push (if (symbolp app) (lzb:app app) app) (acceptor-apps server))) - -(defun uninstall-app (server app) - (setf (acceptor-apps server) - (delete (if (symbolp app) (lzb:app app) app) (acceptor-apps server)))) - -;;; Hunchentoot Acceptor Subclass - -(defclass lazybones-acceptor (h:acceptor) - ((installed-apps - :accessor acceptor-apps - :initform nil - :documentation "Instances of LAZYBONES:APP installed to this - acceptor. APPs are, among other things, collections of ENDPOINT - instances. The acceptor instance uses them to dispatch handlers - on requests.")) - (:default-initargs - :address "0.0.0.0")) - -(defmethod h:acceptor-dispatch-request ((acceptor lazybones-acceptor) request) - (loop for app in (acceptor-apps acceptor) - for (endpoint . args) = (lzb::find-endpoint app request) - when endpoint - return (lzb::run-endpoint endpoint args request h:*reply* app) - ;; if no endpoint was found, call next method. - finally (call-next-method))) |