Author: achiumenti Date: Fri Feb 15 10:12:46 2008 New Revision: 9
Modified: trunk/main/claw-core/src/lisplet.lisp trunk/main/claw-core/src/misc.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/tests/test1.lisp Log: added some documentation added lisplet error hanlders logic
Modified: trunk/main/claw-core/src/lisplet.lisp ============================================================================== --- trunk/main/claw-core/src/lisplet.lisp (original) +++ trunk/main/claw-core/src/lisplet.lisp Fri Feb 15 10:12:46 2008 @@ -29,47 +29,110 @@
(in-package :claw)
-;(print *this-file*) - -(defgeneric lisplet-register-function-location (obj function location &key welcome-pagep login-pagep)) -(defgeneric lisplet-register-page-location (obj page-class location &key welcome-pagep login-pagep)) - -(defgeneric lisplet-register-resource-location (obj uri url &optional content-type)) - -(defgeneric lisplet-dispatch-request (obj)) -(defgeneric lisplet-dispatch-method (obj)) -(defgeneric lisplet-protect (lisplet location roles)) -(defgeneric lisplet-check-authorization (lisplet &optional request)) -(defgeneric lisplet-authentication-type (lisplet)) +(defgeneric lisplet-register-function-location (lisplet function location &key welcome-page-p login-page-p) + (:documentation "Registers a function into a lisplet for dispatching. +parameters: +- LISPLET the lisplet that will dispatch the function +- FUNCTION the function to register for dispatching +- LOCATION The url location where the function will be registered (relative to the lisplet base path) +keys: +- :WELCOME-PAGE-P When true, the function will be a welcome page, making the lisplet to redirect direct access to its base path to the expressed location +- :LOGIN-PAGE-P Marks the function as a login page")) + +(defgeneric lisplet-register-page-location (lisplet page-class location &key welcome-page-p login-page-p) + (:documentation "Registers a page into a lisplet for dispatching. +parameters: +- LISPLET the lisplet that will dispatch the page +- PAGE-CLASS symbol name of the page that is to be registerd for dispatching +- LOCATION The url location where the page will be registered (relative to the lisplet base path) +keys: +- :WELCOME-PAGE-P When true, the page will be a welcome page, making the lisplet to redirect direct access to its base path to the expressed location +- :LOGIN-PAGE-P Marks the page as a login page")) + +(defgeneric lisplet-register-resource-location (lisplet resource-path location &optional content-type) + (:documentation "Registers a resource (file or directory) into a lisplet for dispatching. +parameters: +- LISPLET the lisplet that will dispatch the page +- RESOURCE-PATH pathname of a file or directory that is to be registered for dispatching +- LOCATION The url location where the resource will be registered (relative to the lisplet base path) +- CONTENT-TYPE Meaningful only when the resource-path points to a file, indicates the resource content type")) + +(defgeneric lisplet-dispatch-method (lisplet) + (:documentation "Performs authorizations checking then makes a call to LISPLET-DISPATCH-REQUEST +- LISPLET the lisplet object")) + +(defgeneric lisplet-dispatch-request (lisplet) + (:documentation "Dispatches the http request. +- LISPLET the lisplet object")) + +(defgeneric lisplet-protect (lisplet location roles) + (:documentation "protects all the resources that start with the given LOCATION, making them available only if the +user is logged and belongs at least to one of the given roles. +parameters: +- LISPLET the lisplet object. +- LOCATION the location that must be protected. +- ROLES a string list containing all the roles allowed to acces the given location.")) + +(defgeneric lisplet-check-authorization (lisplet &optional request) + (:documentation "Performs authentication and authorization checking. +Sets the return code of each REPLY, to +HTTP-OK+, +HTTP-FORBIDDEN+ or +HTTP-AUTHORIZATION-REQUIRED+. If the +lisplet authentication type is :BASIC and the user isn't logged in, asks for a basic login.")) + +(defgeneric lisplet-authentication-type (lisplet) + (:documentation "When there is no page or function registered into the lisplet as login page returns :BASIC, otherwise returns :FORM. +parameters: +- LISPLET the lisplet object."))
(setf *http-error-handler* + ;;overrides the default hunchentoot error handling #'(lambda (error-code) - (let ((error-page (make-instance 'error-page - :title (format nil "Server error: ~a" error-code) - :error-code error-code))) - (with-output-to-string (*standard-output*) (page-render error-page))))) + (let* ((error-handlers (current-lisplet)) + (handler (gethash error-code error-handlers))) + (if handler + (funcall handler) + (let ((error-page (make-instance 'error-page + :title (format nil "Server error: ~a" error-code) + :error-code error-code))) + (with-output-to-string (*standard-output*) (page-render error-page))))))) + +(defun lisplet-start-session () + "Starts a session boud to the current lisplet base path" + (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (current-lisplet)))))
(defclass lisplet () ((base-path :initarg :base-path - :reader lisplet-base-path) + :reader lisplet-base-path + :documentation "common base path all resources registered into this lisplet") (welcome-page :initarg :welcome-page - :accessor lisplet-welcome-page) + :accessor lisplet-welcome-page + :documentation "url location for the welcome page") (login-page :initarg :login-page - :accessor lisplet-login-page) + :accessor lisplet-login-page + :documentation "url location for the welcome page") (realm :initarg :realm - :reader lisplet-realm) + :reader lisplet-realm + :documentation "realm for requests that pass through this lisplet and session opened into this lisplet") (pages :initform nil - :accessor lisplet-pages) + :accessor lisplet-pages + :documentation "A collection of cons where the car is an url location and the cdr is a dispatcher") + (error-handlers :initform (make-hash-table) + :accessor lisplet-error-hadlers + :documentation "An hash table where keys are http error codes and values are functions with no parameters") (protected-resources :initform nil - :accessor lisplet-protected-resources) + :accessor lisplet-protected-resources + :documentation "A collection of cons where the car is the protected url location and the cdr is a string list of roles allowhed to access the relative location") (redirect-protected-resources-p :initarg :redirect-protected-resources-p - :accessor lisplet-redirect-protected-resources-p)) + :accessor lisplet-redirect-protected-resources-p + :documentation "When not null every request will be redirected in https mode. When running in mod-lisp mode, *apache-http-port* and *apache-https-port* values are used")) (:default-initargs :welcome-page nil :login-page nil :realm "claw" - :redirect-protected-resources-p nil)) + :redirect-protected-resources-p nil) + (:documentation "A lisplet is a container for resources provided trhough the clawserver. +It is similar, for purposes, to a JAVA servlet"))
(defun build-lisplet-location (lisplet location) + "Constructs a full path prepending the lisplet base path to the given location" (let ((server-base-path *clawserver-base-path*) (base-path (lisplet-base-path lisplet))) (if location @@ -84,36 +147,36 @@ :form :basic))
-(defmethod lisplet-register-function-location ((obj lisplet) function location &key welcome-pagep login-pagep) - (let ((pages (lisplet-pages obj)) - (new-location (build-lisplet-location obj location))) - (setf (lisplet-pages obj) +(defmethod lisplet-register-function-location ((lisplet lisplet) function location &key welcome-page-p login-page-p) + (let ((pages (lisplet-pages lisplet)) + (new-location (build-lisplet-location lisplet location))) + (setf (lisplet-pages lisplet) (sort-dispatchers (push-location-cons (cons new-location (create-prefix-dispatcher new-location function - (lisplet-realm obj))) + (lisplet-realm lisplet))) pages))) - (when welcome-pagep - (setf (lisplet-welcome-page obj) new-location)) - (when login-pagep - (setf (lisplet-login-page obj) new-location)))) - -(defmethod lisplet-register-page-location ((obj lisplet) page-class location &key welcome-pagep login-pagep) - (let ((new-location (build-lisplet-location obj location))) - (lisplet-register-function-location obj + (when welcome-page-p + (setf (lisplet-welcome-page lisplet) new-location)) + (when login-page-p + (setf (lisplet-login-page lisplet) new-location)))) + +(defmethod lisplet-register-page-location ((lisplet lisplet) page-class location &key welcome-page-p login-page-p) + (let ((new-location (build-lisplet-location lisplet location))) + (lisplet-register-function-location lisplet #'(lambda () (with-output-to-string (*standard-output*) - (page-render (make-instance page-class :lisplet obj :url new-location)))) + (page-render (make-instance page-class :lisplet lisplet :url new-location)))) location - :welcome-pagep welcome-pagep - :login-pagep login-pagep))) + :welcome-page-p welcome-page-p + :login-page-p login-page-p)))
-(defmethod lisplet-register-resource-location ((obj lisplet) resource-path location &optional content-type) - (let ((pages (lisplet-pages obj)) - (new-location (build-lisplet-location obj location))) - (setf (lisplet-pages obj) +(defmethod lisplet-register-resource-location ((lisplet lisplet) resource-path location &optional content-type) + (let ((pages (lisplet-pages lisplet)) + (new-location (build-lisplet-location lisplet location))) + (setf (lisplet-pages lisplet) (sort-dispatchers (push-location-cons (cons new-location (if (directory-pathname-p resource-path) @@ -121,30 +184,28 @@ (create-static-file-dispatcher-and-handler new-location resource-path content-type))) pages)))))
-(defmethod lisplet-dispatch-request ((obj lisplet)) - (let ((pages (lisplet-pages obj))) +(defmethod lisplet-dispatch-request ((lisplet lisplet)) + (let ((pages (lisplet-pages lisplet))) (loop for dispatcher in pages for action = (funcall (cdr dispatcher) *request*) - when action return (progn - ;; handle authentication - (funcall action))))) + when action return (funcall action))))
-(defmethod lisplet-dispatch-method ((obj lisplet)) +(defmethod lisplet-dispatch-method ((lisplet lisplet)) (let ((result nil) - (base-path (build-lisplet-location obj nil)) + (base-path (build-lisplet-location lisplet nil)) (uri (request-uri)) - (welcome-page (lisplet-welcome-page obj))) + (welcome-page (lisplet-welcome-page lisplet))) (progn - (setf (aux-request-value 'lisplet) obj) - (setf (aux-request-value 'realm) (lisplet-realm obj)) - (lisplet-check-authorization obj) + (setf (aux-request-value 'lisplet) lisplet) + (setf (aux-request-value 'realm) (lisplet-realm lisplet)) + (lisplet-check-authorization lisplet) (when (= (return-code) +http-ok+) (if (and welcome-page (string= uri base-path)) (progn - (redirect (lisplet-welcome-page obj)) + (redirect (lisplet-welcome-page lisplet)) t) (progn - (setf result (lisplet-dispatch-request obj)) + (setf result (lisplet-dispatch-request lisplet)) (when (null result) (setf (return-code) +http-not-found+)) result)))))) @@ -157,7 +218,8 @@ (cons new-location roles) protected-resources)))))
-(defun redirect-to-https (server request) +(defun redirect-to-https (server request) + "Redirects a request sent through http using https" (cond ((= (server-port request) (clawserver-port server)) (progn @@ -204,6 +266,3 @@ (unless (user-in-role-p) (setf (return-code) +http-forbidden+) (throw 'handler-done nil)))))))) - -(defun lisplet-start-session () - (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (current-lisplet))))) \ No newline at end of file
Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Fri Feb 15 10:12:46 2008 @@ -29,8 +29,10 @@
(in-package :claw)
-(defvar *apache-http-port* 80) -(defvar *apache-https-port* 443) +(defvar *apache-http-port* 80 + "Default apache http port when claw is running in mod_lisp mode") +(defvar *apache-https-port* 443 + "Default apache https port when claw is running in mod_lisp mode")
(defun strings-to-jsarray (strings) "Transforms a list of strings into a javascript array."
Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Fri Feb 15 10:12:46 2008 @@ -230,6 +230,7 @@ :lisplet-protect :lisplet-authentication-type :lisplet-start-session + :lisplet-error-handlers :lisplet-redirect-protected-resources-p ;; clawserver :clawserver
Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Fri Feb 15 10:12:46 2008 @@ -139,7 +139,7 @@
(defun test-image-file () (make-pathname :directory (append (pathname-directory *this-file*) '("img")) :name "matrix" :type "jpg")) -(lisplet-register-page-location *test-lisplet* 'index-page "index.html" :welcome-pagep t) +(lisplet-register-page-location *test-lisplet* 'index-page "index.html" :welcome-page-p t)
(lisplet-register-resource-location *test-lisplet* (test-image-file) "images/matrix.jpg" "image/jpeg")
@@ -255,7 +255,7 @@ (aux-request-value 'password) (login-page-password login-page)) (login))
-(lisplet-register-page-location *test-lisplet* 'login-page "login.html" :login-pagep t) +(lisplet-register-page-location *test-lisplet* 'login-page "login.html" :login-page-p t)
(defclass form-page (page) ((name :initarg :name