From achiumenti at common-lisp.net Fri Feb 15 10:27:32 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Fri, 15 Feb 2008 05:27:32 -0500 (EST) Subject: [claw-cvs] r5 - in trunk/main/claw-core: src tests tests/img Message-ID: <20080215102732.836C855356@common-lisp.net> Author: achiumenti Date: Fri Feb 15 05:27:29 2008 New Revision: 5 Added: trunk/main/claw-core/tests/img/ trunk/main/claw-core/tests/img/matrix.jpg (contents, props changed) 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/src/server.lisp trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/tests/test1.lisp Log: added authentication/authorization 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 05:27:29 2008 @@ -31,27 +31,43 @@ ;(print *this-file*) -(defgeneric lisplet-register-function-location (obj function location &optional welcome-pagep)) -(defgeneric lisplet-register-page-location (obj page-class location &optional welcome-pagep)) +(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)) + +(setf *http-error-handler* + #'(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))))) (defclass lisplet () ((base-path :initarg :base-path :reader lisplet-base-path) (welcome-page :initarg :welcome-page :accessor lisplet-welcome-page) + (login-page :initarg :login-page + :accessor lisplet-login-page) (realm :initarg :realm :reader lisplet-realm) (pages :initform nil :accessor lisplet-pages) - (page404 :initarg :page404 - :accessor lisplet-page404)) - (:default-initargs :welcome-page nil :realm nil :page404 (make-instance 'page404))) + (protected-resources :initform nil + :accessor lisplet-protected-resources) + (redirect-protected-resources-p :initarg :redirect-protected-resources-p + :accessor lisplet-redirect-protected-resources-p)) + (:default-initargs :welcome-page nil + :login-page nil + :realm "claw" + :redirect-protected-resources-p nil)) (defun build-lisplet-location (lisplet location) (let ((server-base-path *clawserver-base-path*) @@ -63,39 +79,27 @@ (setf location (format nil "~a~a" server-base-path location))) location)) -(defmethod lisplet-register-function-location ((obj lisplet) function location &optional welcome-pagep) +(defmethod lisplet-authentication-type ((lisplet lisplet)) + (if (lisplet-login-page lisplet) + :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) - (sort-dispatchers (push-dispatcher + (sort-dispatchers (push-location-cons (cons new-location (create-prefix-dispatcher new-location function (lisplet-realm obj))) pages))) (when welcome-pagep - (setf (lisplet-welcome-page obj) new-location)))) + (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 &optional welcome-pagep content-type) - (let ((pages (lisplet-pages obj)) - (new-location (build-lisplet-location obj location))) - (setf (lisplet-pages obj) - (sort-dispatchers (push-dispatcher - (cons new-location - (create-prefix-dispatcher new-location - #'(lambda () - (with-output-to-string - (*standard-output*) - (page-render (make-instance page-class :lisplet obj :url new-location)))) - (lisplet-realm obj) - content-type)) - pages))) - (when welcome-pagep - (setf (lisplet-welcome-page obj) new-location)))) -|# - -(defmethod lisplet-register-page-location ((obj lisplet) page-class location &optional welcome-pagep) +(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 #'(lambda () @@ -103,13 +107,14 @@ (*standard-output*) (page-render (make-instance page-class :lisplet obj :url new-location)))) location - welcome-pagep))) + :welcome-pagep welcome-pagep + :login-pagep login-pagep))) (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) - (sort-dispatchers (push-dispatcher + (sort-dispatchers (push-location-cons (cons new-location (if (directory-pathname-p resource-path) (create-folder-dispatcher-and-handler new-location resource-path) @@ -117,23 +122,87 @@ pages))))) (defmethod lisplet-dispatch-request ((obj lisplet)) - (let ((pages (lisplet-pages obj))) + (let ((pages (lisplet-pages obj))) (loop for dispatcher in pages for action = (funcall (cdr dispatcher) *request*) - when action return (funcall action)))) + when action return (progn + ;; handle authentication + (funcall action))))) (defmethod lisplet-dispatch-method ((obj lisplet)) - (let ((page404 (lisplet-page404 obj)) - (result nil) + (let ((result nil) (base-path (build-lisplet-location obj nil)) (uri (request-uri)) (welcome-page (lisplet-welcome-page obj))) - (if (and welcome-page (string= uri base-path)) - (progn - (redirect (lisplet-welcome-page obj)) - t) - (progn - (setf result (lisplet-dispatch-request obj)) - (when (null result) - (setf result (with-output-to-string (*standard-output*) (page-render page404)))) - result)))) + (progn + (setf (aux-request-value 'lisplet) obj) + (setf (aux-request-value 'realm) (lisplet-realm obj)) + (lisplet-check-authorization obj) + (when (= (return-code) +http-ok+) + (if (and welcome-page (string= uri base-path)) + (progn + (redirect (lisplet-welcome-page obj)) + t) + (progn + (setf result (lisplet-dispatch-request obj)) + (when (null result) + (setf (return-code) +http-not-found+)) + result)))))) + +(defmethod lisplet-protect ((lisplet lisplet) location roles) + (let ((protected-resources (lisplet-protected-resources lisplet)) + (new-location (build-lisplet-location lisplet location))) + (setf (lisplet-protected-resources lisplet) + (sort-protected-resources (push-location-cons + (cons new-location roles) + protected-resources))))) + +(defun redirect-to-https (server request) + (cond + ((= (server-port request) (clawserver-port server)) + (progn + (redirect (request-uri request) + :port (clawserver-sslport server) + :protocol :HTTPS) + (throw 'handler-done nil))) + ((= (server-port request) *apache-http-port*) + (progn + (redirect (request-uri request) + :port *apache-https-port* + :protocol :HTTPS) + (throw 'handler-done nil))))) + +(defmethod lisplet-check-authorization ((lisplet lisplet) &optional (request *request*)) + (let ((uri (request-uri request)) + (protected-resources (lisplet-protected-resources lisplet)) + (princp (current-principal)) + (login-config (current-config)) + (login-page (lisplet-login-page lisplet)) + (server (current-server request)) + (auth-basicp (eq (lisplet-authentication-type lisplet) :basic))) + (when (and auth-basicp (null princp)) + (configuration-login login-config)) + (setf (return-code) +http-ok+ + princp (current-principal)) + (when (and login-page + (cl-ppcre:all-matches login-page uri)) + (redirect-to-https server request)) + (loop for protected-resource in protected-resources + for match = (format nil "^~a" (car protected-resource)) + for allowed-roles = (cdr protected-resource) + do (when (cl-ppcre:all-matches match uri) + (when (lisplet-redirect-protected-resources-p lisplet) + (redirect-to-https server request)) + (if (null princp) + (progn + (when auth-basicp + (setf (header-out "WWW-Authenticate") + (format nil "Basic realm=\"~A\"" (hunchentoot::quote-string (current-realm))))) + (setf (return-code) +http-authorization-required+) + (throw 'handler-done nil)) + (unless (loop for role in (principal-roles princp) thereis (member role allowed-roles :test #'equal)) + (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 05:27:29 2008 @@ -29,7 +29,9 @@ (in-package :claw) - +(defvar *apache-http-port* 80) +(defvar *apache-https-port* 443) + (defun strings-to-jsarray (strings) "Transforms a list of strings into a javascript array." (let ((st-size (length strings)) @@ -50,14 +52,43 @@ (sort dispatchers #'(lambda (item1 item2) (string-not-lessp (car item1) (car item2))))) -(defun remove-dispatcher-by-location (location dispatchers) - "Removes a dispatcher cons (location.dispatcher-method) checking its car +(defun sort-protected-resources (protected-resources) + "Sorts a list of protected resources. A protected resource is a cons where the car is the url +of the resource and the cdr is a list of roles allowhed to access that resource." + (sort protected-resources #'(lambda (item1 item2) + (string-lessp (car item1) (car item2))))) + +(defun remove-by-location (location cons-list) + "Removes a cons checking its car against the location parameter" - (delete-if #'(lambda (dispatcher) (string= (car dispatcher) location)) dispatchers)) + (delete-if #'(lambda (item) (string= (car item) location)) cons-list)) -(defun push-dispatcher (dispatcher dispatchers) - "Isert a new dispatcher into dispatchers, or replace the one that has the same location +(defun push-location-cons (location-cons cons-list) + "Isert a new cons into a list of cons, or replace the one that has the same location registered (its car)." - (let ((result (remove-dispatcher-by-location (car dispatcher) dispatchers))) - (setf result (push dispatcher dispatchers)))) + (let ((result (remove-by-location (car location-cons) cons-list))) + (setf result (push location-cons cons-list)))) +(defun current-realm (&optional (request *request*)) + (aux-request-value 'realm request)) + +(defun current-lisplet (&optional (request *request*)) + (aux-request-value 'lisplet request)) + +(defun current-server (&optional (request *request*)) + (aux-request-value 'clawserver request)) + +(defun current-principal (&optional (session *session*)) + (when session + (session-value 'principal))) + +(defun user-in-rolep (roles &optional (session *session*)) + (let ((principal (current-principal session))) + (when principal + (loop for el in (principal-roles principal) thereis (member el roles))))) + +(defun current-config (&optional (request *request*)) + (gethash (current-realm request) (clawserver-login-config (current-server)))) + +(defun login (&optional (request *request*)) + (configuration-login (current-config request))) \ No newline at end of file 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 05:27:29 2008 @@ -43,6 +43,8 @@ :*default-encoding* :*rewind-parameter* :*clawserver-base-path* + :*apache-http-port* + :*apache-https-port* ;:request-realm :request-id-table-map ;:dyna-id @@ -225,6 +227,10 @@ :lisplet-register-page-location :lisplet-register-function-location :lisplet-register-resource-location + :lisplet-protect + :lisplet-authentication-type + :lisplet-start-session + :lisplet-redirect-protected-resources-p ;; clawserver :clawserver :clawserver-register-lisplet @@ -241,8 +247,23 @@ :clawserver-input-chunking-p :clawserver-read-timeout :clawserver-write-timeout + :clawserver-login-config + :login #+(and :unix (not :win32)) :clawserver-setuid #+(and :unix (not :win32)) :clawserver-setgid #-:hunchentoot-no-ssl :clawserver-ssl-certificate-file #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-file - #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-password)) + #-:hunchentoot-no-ssl :clawserver-ssl-privatekey-password + :clawserver-register-configuration + :claw-require-authorization + :configuration + :configuration-login + :principal + :current-principal + :principal-name + :principal-roles + :current-lisplet + :current-server + :current-realm + :user-in-rolep + :login)) Modified: trunk/main/claw-core/src/server.lisp ============================================================================== --- trunk/main/claw-core/src/server.lisp (original) +++ trunk/main/claw-core/src/server.lisp Fri Feb 15 05:27:29 2008 @@ -62,11 +62,25 @@ #-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-certificate-file) (val obj)) #-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-privatekey-file) (val obj)) #-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-privatekey-password) (val obj)) +(defgeneric clawserver-register-configuration(clawserver realm configuration)) +(defgeneric configuration-login (configuration &optional request)) -(defclass page404 (page) - ((style :initform - " +(define-condition http-forbidden-error (error) ()) +(define-condition http-authorization-required-error (error) ()) + +(defclass error-page (page) + ((title :initarg :title + :reader page-title) + (error-code :initarg :error-code + :reader page-error-code)) + (:documentation "This is the template page class used to render +the http error messages.")) + +(defcomponent error-page-template () ()) +(defmethod wcomponent-parameters ((error-page-template error-page-template)) + (list :title :required :error-code :required :style + " body { font-family: arial, elvetica; font-size: 7pt; @@ -85,39 +99,43 @@ margin: 0; margin-bottom: .5em; } -p.h2 {font-size: 1.5em;}" - :reader page404-style)) - (:documentation "This page class is used to render -the 404 (page not found) messages.")) - -(defmethod page-content ((obj page404)) - (html> - (head> - (title> - "404 Page not found") - (style> - (page404-style obj))) - (body> - (p> - (p> :class "h1" - (format nil "HTTP Status 404 - ~a" (request-uri *request*))) - (hr> :noshade "noshade") - (p> - (span> :class "blue" - ($> "type")) - "Status report") - (p> - (span> :class "blue" - "message") - (request-uri *request*)) - (p> - (span> :class "blue" - "description") - (format nil "The requested resource (~a) is not available." (request-uri *request*))) - (hr> :noshade "noshade")) - (p> :class "h2" - "cl-webobject server")))) +p.h2 {font-size: 1.5em;}")) +(defmethod wcomponent-template ((error-page-template error-page-template)) + (let ((error-code (wcomponent-parameter-value error-page-template ':error-code)) + (title (wcomponent-parameter-value error-page-template ':title)) + (style (wcomponent-parameter-value error-page-template ':style))) + (html> + (head> + (title> title) + (style> style)) + (body> + (p> + (p> :class "h1" + (format nil "HTTP Status ~a - ~a" error-code (request-uri *request*))) + (hr> :noshade "noshade") + (p> + (span> :class "blue" + ($> "type")) + "Status report") + (p> + (span> :class "blue" + "url") + (request-uri *request*)) + (p> + (span> :class "blue" + "description") + (gethash error-code hunchentoot::*http-reason-phrase-map*) + ;(htcomponent-body error-page-template) + (hr> :noshade "noshade")) + (p> :class "h2" + "claw server")))))) + +(defmethod page-content ((error-page error-page)) + (error-page-template> :title (page-title error-page) + :error-code (page-error-code error-page) + (format nil "The requested resource (~a) is not available." (request-uri *request*)))) + (defclass clawserver () ((port :initarg :port :reader clawserver-port) @@ -130,7 +148,7 @@ (sslname :initarg :sslname :reader clawserver-sslname) (mod-lisp-p :initarg :mod-lisp-p - :reader clawserver-mod-lisp-p) + :reader clawserver-mod-lisp-p) (use-apache-log-p :initarg :use-apache-log-p :reader clawserver-use-apache-log-p) (input-chunking-p :initarg :input-chunking-p @@ -139,6 +157,11 @@ :reader clawserver-read-timeout) (write-timeout :initarg :write-timeout :reader clawserver-write-timeout) + (login-config :initform (make-hash-table :test 'equal) + :accessor clawserver-login-config + :documentation "An hash table holding a pair of realm, +expressed as string, and a predicate. The predicate should take two arguments (login and password), and return non-nil if the login call +succeeds.") #+(and :unix (not :win32)) (setuid :initarg :setuid :reader clawserver-setuid) #+(and :unix (not :win32)) (setgid :initarg :setgid @@ -154,26 +177,40 @@ (sslserver :initform nil :accessor clawserver-sslserver) (lisplets :initform nil - :accessor clawserver-lisplets) - (page404 :initarg :page404 - :accessor clawserver-page404)) + :accessor clawserver-lisplets)) (:default-initargs :address nil :name (gensym) :sslname (gensym) :port 80 :sslport 443 - :mod-lisp-p nil + :mod-lisp-p nil :input-chunking-p t :read-timeout *default-read-timeout* :write-timeout *default-write-timeout* #+(and :unix (not :win32)) :setuid nil #+(and :unix (not :win32)) :setgid nil #-:hunchentoot-no-ssl :ssl-certificate-file nil - #-:hunchentoot-no-ssl :ssl-privatekey-password nil - :page404 (make-instance 'page404)) + #-:hunchentoot-no-ssl :ssl-privatekey-password nil) (:documentation "CLAWSERVER is built around huncentoot and has the instructions for lisplet dispatching, so use this class to start and stop -hunchentoot server.")) +3hunchentoot server.")) + +(defclass configuration () + () + (:documentation "A configuration class for CLAW server realm login configurations")) + +(defmethod configuration-login ((configuration configuration) &optional (request *request*)) + (declare (ignore request))) + +(defclass principal () + ((name :initarg :name + :reader principal-name + :documentation "The principal username who is logged into the application") + (roles :initarg :roles + :accessor principal-roles + :documentation "The roles where that owns the user logged into the application")) + (:default-initargs :roles nil) + (:documentation "An instance of PRINCIPAL is stored into session after a user successfully login into the application.")) (defmethod initialize-instance :after ((obj clawserver) &rest keys) (let ((use-apache-log-p (getf keys :use-apache-log-p :undefined)) @@ -189,7 +226,7 @@ (location (lisplet-base-path lisplet-obj))) (unless (null server-base-path) (setf location (format nil "~@[~a~]~a" server-base-path location))) - (setf (clawserver-lisplets obj) (sort-dispatchers (push-dispatcher + (setf (clawserver-lisplets obj) (sort-dispatchers (push-location-cons (cons location (create-prefix-dispatcher location @@ -204,7 +241,7 @@ (location (lisplet-base-path lisplet-obj))) (unless (null server-base-path) (setf location (format nil "~@[~a~]~a" server-base-path location))) - (remove-dispatcher-by-location location lisplets))) + (remove-by-location location lisplets))) ;;;-------------------------- WRITERS ---------------------------------------- @@ -285,6 +322,9 @@ (setf (slot-value obj 'ssl-privatekey-password) val)) ;;;-------------------------- METHODS ---------------------------------------- +(defmethod clawserver-register-configuration ((clawserver clawserver) realm (configuration configuration)) + (setf (gethash realm (clawserver-login-config clawserver)) configuration)) + (defmethod clawserver-dispatch-request ((obj clawserver)) (let ((lisplets (clawserver-lisplets obj))) (loop for dispatcher in lisplets @@ -292,12 +332,13 @@ when action return (funcall action)))) (defmethod clawserver-dispatch-method ((obj clawserver)) - (let ((page404 (clawserver-page404 obj)) - (result nil)) + (let ((result nil)) (progn + (setf (aux-request-value 'clawserver) obj) (setf result (clawserver-dispatch-request obj)) (if (null result) - #'(lambda () (with-output-to-string (*standard-output*) (page-render page404))) + #'(lambda () (when (= (return-code) +http-ok+) + (setf (return-code *reply*) +http-not-found+))) #'(lambda () result))))) (defmethod clawserver-start ((obj clawserver)) @@ -355,6 +396,13 @@ (when (clawserver-sslserver obj) (setf (clawserver-sslserver obj) (stop-server (clawserver-sslserver obj)))))) ;;;---------------------------------------------------------------------------- +(defun login (&optional (request *request*)) + (let* ((server (aux-request-value 'clawserver)) + (realm (aux-request-value 'realm)) + (login-config (gethash realm (clawserver-login-config server)))) + (configuration-login login-config request))) + + (defun start-clawserver (clawserver-obj &key (port 80) address @@ -385,5 +433,30 @@ #-:hunchentoot-no-ssl :ssl-certificate-file ssl-certificate-file #-:hunchentoot-no-ssl :ssl-privatekey-file ssl-privatekey-file #-:hunchentoot-no-ssl :ssl-privatekey-password ssl-privatekey-password)) - - \ No newline at end of file + +#| + (defun claw-require-authorization (&optional (request *request*)) + "Sends back appropriate headers to require basic HTTP authentication +\(see RFC 2617) for the realm REALM." + ;(log-message :info "REALM:::::: ~a" (current-realm)) + (setf (header-out "WWW-Authenticate") + (format nil "Basic realm=\"~A\"" (hunchentoot::quote-string (current-realm))) + (return-code *reply*) + +http-authorization-required+) + (throw 'handler-done nil)) +|# + +#| + (defun claw-require-authorization (&optional (request *request*)) + "Sends back appropriate headers to require basic HTTP authentication +\(see RFC 2617) for the realm REALM." + ;(log-message :info "REALM:::::: ~a" (current-realm)) + (when (eq (lisplet-authentication-type lisplet) :basic) + (setf (header-out "WWW-Authenticate") + (format nil "Basic realm=\"~A\"" (hunchentoot::quote-string (current-realm))) +; (setf (return-code *reply*) +; +http-authorization-required+) + (cond + ((null (principal)) (setf (return-code) +http-authorization-required+)) + (t (setf (return-code) +http-forbidden+)))) +|# \ No newline at end of file Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Fri Feb 15 05:27:29 2008 @@ -273,7 +273,7 @@ (result)) (if (= 0 client-id-index) (setf result id) - (setf result (format nil "~a~d" id client-id-index))) + (setf result (format nil "~a_~d" id client-id-index))) (setf (gethash id id-ht) (1+ client-id-index)) result)) @@ -288,7 +288,7 @@ (id (getf (first fbody) :id)) (static-id (getf (first fbody) :static-id)) (instance)) - (unless (null static-id) + (when static-id (remf (first fbody) :id) (setf id nil)) (setf instance (make-instance parent @@ -297,7 +297,7 @@ :attributes (first fbody) :body (second fbody))) (if (null static-id) - (unless (or (null id-table-map) (null id)) + (when (and id-table-map id) (setf (htcomponent-client-id instance) (generate-id id))) (setf (htcomponent-client-id instance) static-id)) @@ -486,14 +486,13 @@ (defmethod (setf htcomponent-page) ((pobj page) (obj htcomponent)) (let ((id (getf (htcomponent-attributes obj) :id)) - (static-id (getf (htcomponent-attributes obj) :static-id))) + (static-id (getf (htcomponent-attributes obj) :static-id)) + (client-id (htcomponent-client-id obj))) (setf (slot-value obj 'page) pobj) - (unless (and (null id) (null static-id)) - (let ((client-id (htcomponent-client-id obj))) - (when (null client-id) - (if (null static-id) - (setf (htcomponent-client-id obj) (generate-id id)) - (setf (htcomponent-client-id obj) static-id))))))) + (unless client-id + (if static-id + (setf (htcomponent-client-id obj) static-id) + (setf (htcomponent-client-id obj) (generate-id id)))))) (defmethod page-request-parameters ((pobj page)) (if (and (boundp '*request*) (null (slot-value pobj 'request-parameters))) @@ -509,7 +508,7 @@ (defmethod page-req-parameter ((pobj page) name &optional as-list) (let ((parameters (page-request-parameters pobj)) (retval)) - (unless (null parameters) + (when parameters (setf retval (gethash (string-upcase name) parameters)) (if (or (null retval) as-list) retval @@ -551,28 +550,30 @@ (xml-p (page-xmloutput obj)) (content-type (page-doc-type obj))) (when (null json-p) - (unless (null xml-p) + (when xml-p (page-format-raw obj "~%" encoding)) - (unless (null content-type) + (when content-type (page-format-raw obj "~a~%" content-type))))) -(defmethod page-render ((obj page)) +(defmethod page-render ((obj page)) (let ((body (page-content obj)) (json-p (page-json-id-list obj))) (if (null body) (format nil "null body for page ~a~%" (type-of obj)) (progn (page-init obj) - (unless (null (page-req-parameter obj *rewind-parameter*)) + (when (page-req-parameter obj *rewind-parameter*) (htcomponent-rewind body obj)) (page-init obj) (htcomponent-prerender (page-content obj) obj) ;Here we need a fresh new body!!! (page-render-headings obj) (page-init obj) - (unless (null json-p) + (when json-p (page-format-raw obj "{components:{")) + + (setf (page-can-print obj) t) (htcomponent-render (page-content obj) obj) ;Here we need a fresh new body!!! - (unless (null json-p) + (when json-p (page-format-raw obj "},classInjections:\"") (setf (page-can-print obj) t) (dolist (injection (page-init-injections obj)) @@ -640,7 +641,8 @@ (let* ((pobj (htcomponent-page obj)) (json-p (page-json-id-list pobj)) (id (htcomponent-client-id obj))) - (unless (or (null json-p) (null (member id json-p :test #'string-equal))) + (when (or json-p + (member id json-p :test #'string-equal)) (when (> (page-json-component-count pobj) 0) (page-format pobj ",")) (page-format-raw pobj "~a:\"" id) @@ -650,7 +652,8 @@ (let* ((pobj (htcomponent-page obj)) (json-p (page-json-id-list pobj)) (id (htcomponent-client-id obj))) - (unless (or (null json-p) (null (member id json-p :test #'string-equal))) + (when (or json-p + (member id json-p :test #'string-equal)) (page-format-raw pobj "\"")))) (defmethod htcomponent-rewind :before ((obj htcomponent) (pobj page)) @@ -667,6 +670,7 @@ (defmethod htcomponent-prerender ((obj htcomponent) (pobj page)) (let ((previous-print-status (page-can-print pobj))) +; (log-message :info "------------------- ~a" previous-print-status) (when (null previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj))) (dolist (tag (htcomponent-body obj)) @@ -677,7 +681,7 @@ (defmethod htcomponent-render ((obj htcomponent) (pobj page)) (let ((body-list (htcomponent-body obj)) - (previous-print-status (page-can-print pobj))) + (previous-print-status (page-can-print pobj))) (when (null previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj)) (htcomponent-json-print-start-component obj)) @@ -691,11 +695,11 @@ ;;;========= TAG ===================================== (defmethod tag-render-attributes ((obj tag) (pobj page)) - (unless (null (htcomponent-attributes obj)) + (when (htcomponent-attributes obj) (loop for (k v) on (htcomponent-attributes obj) by #'cddr do (progn (assert (keywordp k)) - (unless (null v) + (when v (page-format pobj " ~a=\"~a\"" (string-downcase (if (eq k :static-id) "id" @@ -744,15 +748,15 @@ (when (null previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj)) (htcomponent-json-print-start-component obj)) - (unless (or (null (page-can-print pobj)) (null previous-print-status)) + (when (or (page-can-print pobj) previous-print-status) (tag-render-starttag obj pobj)) (dolist (tag body-list) (if (stringp tag) (htcomponent-render ($> tag) pobj) (htcomponent-render tag pobj))) - (unless (or (null (page-can-print pobj)) (null previous-print-status)) + (when (or (page-can-print pobj) previous-print-status) (tag-render-endtag obj pobj)) - (when (null previous-print-status) + (unless previous-print-status (setf (page-can-print pobj) nil) (htcomponent-json-print-end-component obj)))) @@ -779,8 +783,8 @@ (let ((body (htcomponent-body obj)) (json-p (not (null (page-json-id-list pobj)))) (print-p (page-can-print pobj))) - (unless (or (null print-p) (null body)) - (unless (null json-p) + (when (or print-p body) + (when json-p (setf body (regex-replace-all "\"" (regex-replace-all "\\\\\"" (regex-replace-all "\\n" @@ -788,14 +792,14 @@ "\\n") "\\\\\\\"") "\\\""))) - (if (null (htstring-raw obj)) + (if (htstring-raw obj) + (page-format-raw pobj body) (loop for ch across body do (case ch ((#\<) (page-format-raw pobj "<")) ((#\>) (page-format-raw pobj ">")) ((#\&) (page-format-raw pobj "&")) - (t (page-format-raw pobj "~a" ch)))) - (page-format-raw pobj body))))) + (t (page-format-raw pobj "~a" ch)))))))) ;;;========= HTSCRIPT =================================== (defmethod htcomponent-prerender((obj htscript) (pobj page))) @@ -809,7 +813,7 @@ (htcomponent-json-print-start-component obj)) (unless (getf (htcomponent-attributes obj) :type) (append '(:type "text/javascript") (htcomponent-attributes obj))) - (unless (null (page-can-print pobj)) + (when (page-can-print pobj) (tag-render-starttag obj pobj) (when (and (null (getf (htcomponent-attributes obj) :src)) (not (null (htcomponent-body obj)))) @@ -838,7 +842,7 @@ (when (null previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj)) (htcomponent-json-print-start-component obj)) - (unless (null (page-can-print pobj)) + (when (page-can-print pobj) (unless (getf (htcomponent-attributes obj) :type) (append '(:type "text/css") (htcomponent-attributes obj))) (unless (getf (htcomponent-attributes obj) :rel) @@ -853,19 +857,19 @@ (defmethod htcomponent-render ((obj htbody) (pobj page)) (let ((body-list (htcomponent-body obj)) (previous-print-status (page-can-print pobj))) - (unless (or (null (page-can-print pobj)) (null previous-print-status)) + (when (or (page-can-print pobj) previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj)) (htcomponent-json-print-start-component obj)) - (unless (null (page-can-print pobj)) + (when (page-can-print pobj) (tag-render-starttag obj pobj)) (dolist (tag body-list) (if (stringp tag) (htcomponent-render ($> tag) pobj) (htcomponent-render tag pobj))) - (unless (null (page-can-print pobj)) + (when (page-can-print pobj) (htcomponent-render (htbody-init-scripts-tag pobj) pobj) (tag-render-endtag obj pobj)) - (unless (or (null (page-can-print pobj)) (null previous-print-status)) + (when (or (page-can-print pobj) previous-print-status) (setf (page-can-print pobj) nil) (htcomponent-json-print-end-component obj)))) @@ -920,7 +924,7 @@ (defun make-component (name parameters content) (let ((instance (make-instance name)) (static-id (getf parameters :static-id))) - (unless (null static-id) + (when static-id (remf parameters :id)) (loop for (k v) on parameters by #'cddr do (let ((keyword k)) @@ -929,7 +933,7 @@ (multiple-value-bind (inst-k inst-v inst-p) (get-properties (wcomponent-parameters instance) (list keyword)) (declare (ignore inst-v)) - (unless (null (find inst-k (wcomponent-reserved-parameters instance))) + (when (find inst-k (wcomponent-reserved-parameters instance)) (error (format nil "Parameter ~a is reserved" inst-k))) (if (null inst-p) (if (null (wcomponent-allow-informal-parametersp instance)) @@ -999,14 +1003,14 @@ (template (wcomponent-template obj))) (when (null previous-print-status) (setf (page-can-print pobj) (htcomponent-can-print obj))) - (unless (null (page-can-print pobj)) + (when (page-can-print pobj) (dolist (script (htcomponent-script-files obj)) (pushnew script (page-script-files pobj) :test #'equal)) (dolist (css (htcomponent-stylesheet-files obj)) (pushnew css (page-stylesheet-files pobj) :test #'equal)) (dolist (js (htcomponent-class-initscripts obj)) (pushnew js (page-class-initscripts pobj) :test #'equal)) - (unless (null (htcomponent-instance-initscript obj)) + (when (htcomponent-instance-initscript obj) (pushnew (htcomponent-instance-initscript obj) (page-instance-initscripts pobj) :test #'equal))) (if (listp template) (dolist (tag template) Added: trunk/main/claw-core/tests/img/matrix.jpg ============================================================================== Binary file. No diff available. 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 05:27:29 2008 @@ -29,6 +29,7 @@ (in-package :claw-tests) +(setf *rewrite-for-session-urls* nil) (defvar *this-file* (load-time-value (or #.*compile-file-pathname* *load-pathname*))) @@ -42,14 +43,42 @@ -(defparameter *clawserver* (make-instance 'clawserver :port 4242)) -;;;(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 -;;; :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" -;;; :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) +;;;(defparameter *clawserver* (make-instance 'clawserver :port 4242)) +(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 + :mod-lisp-p t + :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" + :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) +(setf (lisplet-redirect-protected-resources-p *test-lisplet*) t) (clawserver-register-lisplet *clawserver* *test-lisplet*) (clawserver-register-lisplet *clawserver* *test-lisplet2*) +(defun test-configuration-do-login (request user password) + (let ((session *session*)) + (when (and (string-equal user "kiuma") + (string-equal password "password")) + (progn + (unless session + (setf session (lisplet-start-session))) + (setf (session-value 'principal session) (make-instance 'principal :name user :roles '("user"))))))) + + + +(defclass test-configuration (configuration) ()) + +(defmethod configuration-login ((test-configuration test-configuration) &optional (request *request*)) + (let ((lisplet (current-lisplet request))) + (multiple-value-bind (user password) + (if (eq (lisplet-authentication-type lisplet) :basic) + (authorization) + (values (aux-request-value 'user request) + (aux-request-value 'password request))) + (test-configuration-do-login request user password)))) + +(clawserver-register-configuration *clawserver* "test1" (make-instance 'test-configuration)) + + + (defun claw-tst-start () (clawserver-start *clawserver*)) @@ -71,18 +100,29 @@ (wcomponent-parameter-value o ':title))) (body> (wcomponent-informal-parameters o) - (p> - (a> :href "/claw/test/index.html")) + (div> + :style "background-color: #DBDFE0;padding: 3px;" + (a> :href "/claw/test/index.html" "home")) (htcomponent-body o)))) ;;;--------------------index testing page-------------------------------- +(defclass auth-page (page) ()) +(defmethod page-content ((page auth-page)) + (site-template> :title "Unauth test page" + (p> "not here"))) +; (claw-require-authorization)) +(lisplet-register-page-location *test-lisplet* 'auth-page "unauth.html") +(lisplet-protect *test-lisplet* "unauth.html" '("admin" "user")) + (defclass index-page (page) ()) (defmethod page-content ((o index-page)) (site-template> :title "Home test page" (p> :id "p" (ul> + (li> (a> :href "login.html" + "Do login")) (li> (a> :href "images/matrix.jpg" "show static file")) (li> (a> :href "images/matrix2.jpg" @@ -92,11 +132,12 @@ (li> (a> :href "../test2/realm.html" :target "clwo2" "realm on lisplet 'test2'")) (li> (a> :href "id-tests.html" "id generation test")) - (li> (a> :href "form.html" ($> "form components test"))))))) + (li> (a> :href "form.html" "form components test")) + (li> (a> :href "unauth.html" "unauthorized page")))))) (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" t) +(lisplet-register-page-location *test-lisplet* 'index-page "index.html" :welcome-pagep t) (lisplet-register-resource-location *test-lisplet* (test-image-file) "images/matrix.jpg" "image/jpeg") @@ -119,7 +160,7 @@ (let ((lisplet (page-lisplet o))) (when (or (null *session*) (not (string= (session-realm *session*) (lisplet-realm lisplet)))) (progn - (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (page-lisplet o)))) + (lisplet-start-session) (setf (session-value 'RND-NUMBER) (random 1000)))) (site-template> :title "Realm test page" (p> @@ -153,21 +194,67 @@ (hr>) (div> :id "foo" :class "goo" :onclick "this.innerHTML = this.id" + :style "cursor: pointer;" "passed id: 'foo'[click me, to see generated id]") (div> :id "foo" :onclick "this.innerHTML = this.id" + :style "cursor: pointer;" "passed id: 'foo'[click me, to see generated id]") (div> :static-id uid :onclick "this.innerHTML = this.id" + :style "cursor: pointer;" "passed id: 'uid' (generated with generate-id)[click me, to see generated id]") (div> :static-id uid2 :onclick "this.innerHTML = this.id" + :style "cursor: pointer;" "passed id: 'uid' (generated with generate-id)[click me, to see generated id]")))) (lisplet-register-page-location *test-lisplet* 'id-tests-page "id-tests.html") ;;;--------------------from components testing page-------------------------------- + +(defgeneric login-page-login (login-page)) + +(defclass login-page (page) + ((username :initform "" + :accessor login-page-username) + (passowrd :initform "" + :accessor login-page-password))) + +(defmethod page-content ((login-page login-page)) + (let ((princp (current-principal))) + (site-template> :title "a page title" + (if (null princp) + (cform> :id "loginform" :method "post" :action 'login-page-login + (table> + (tr> + (td> "Username") + (td> + (cinput> :id "username" + :type "text" + :accessor 'login-page-username))) + (tr> + (td> "Password") + (td> + (cinput> :id "passowrd" + :type "password" + :accessor 'login-page-password))) + (tr> + (td> :colspan "2" + (csubmit> :id "submit" :value "Login"))))) + (p> + "Welcome " + (principal-name princp) + (a> :href "index.html" "home")))))) + +(defmethod login-page-login ((login-page login-page)) + (setf (aux-request-value 'user) (login-page-username login-page) + (aux-request-value 'password) (login-page-password login-page)) + (login)) + +(lisplet-register-page-location *test-lisplet* 'login-page "login.html" :login-pagep t) + (defclass form-page (page) ((name :initarg :name :accessor form-page-name) From achiumenti at common-lisp.net Fri Feb 15 11:13:45 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Fri, 15 Feb 2008 06:13:45 -0500 (EST) Subject: [claw-cvs] r6 - trunk/main/claw-core/src Message-ID: <20080215111345.858A07A023@common-lisp.net> Author: achiumenti Date: Fri Feb 15 06:13:45 2008 New Revision: 6 Modified: trunk/main/claw-core/src/misc.lisp Log: added some comments 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 06:13:45 2008 @@ -70,25 +70,32 @@ (setf result (push location-cons cons-list)))) (defun current-realm (&optional (request *request*)) + "Returns the realm under which the request has been sent" (aux-request-value 'realm request)) (defun current-lisplet (&optional (request *request*)) + "Returns the lisplet instance from which the request comes from" (aux-request-value 'lisplet request)) (defun current-server (&optional (request *request*)) + "Returns the clawserver instance from which the request comes from" (aux-request-value 'clawserver request)) (defun current-principal (&optional (session *session*)) + "Returns the principal(user) that logged into the application" (when session - (session-value 'principal))) + (session-value 'principal session))) (defun user-in-rolep (roles &optional (session *session*)) + "Detects if current principal belongs to any of the expressed roles" (let ((principal (current-principal session))) (when principal (loop for el in (principal-roles principal) thereis (member el roles))))) (defun current-config (&optional (request *request*)) - (gethash (current-realm request) (clawserver-login-config (current-server)))) + "Returns the current configuration object for the realm of the request" + (gethash (current-realm request) (clawserver-login-config (current-server request)))) (defun login (&optional (request *request*)) + "Perfoms a login action using the configuration object given for the request realm" (configuration-login (current-config request))) \ No newline at end of file From achiumenti at common-lisp.net Fri Feb 15 12:53:36 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Fri, 15 Feb 2008 07:53:36 -0500 (EST) Subject: [claw-cvs] r8 - trunk/main/claw-core/tests Message-ID: <20080215125336.D13835D086@common-lisp.net> Author: achiumenti Date: Fri Feb 15 07:53:35 2008 New Revision: 8 Modified: trunk/main/claw-core/tests/test1.lisp Log: updated tests 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 07:53:35 2008 @@ -43,11 +43,13 @@ -;;;(defparameter *clawserver* (make-instance 'clawserver :port 4242)) +;;(defparameter *clawserver* (make-instance 'clawserver :port 4242)) + (defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 :mod-lisp-p t :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) + (setf (lisplet-redirect-protected-resources-p *test-lisplet*) t) (clawserver-register-lisplet *clawserver* *test-lisplet*) From achiumenti at common-lisp.net Fri Feb 15 12:53:11 2008 From: achiumenti at common-lisp.net (achiumenti at common-lisp.net) Date: Fri, 15 Feb 2008 07:53:11 -0500 (EST) Subject: [claw-cvs] r7 - trunk/main/claw-core/src Message-ID: <20080215125311.F020B56222@common-lisp.net> Author: achiumenti Date: Fri Feb 15 07:53:10 2008 New Revision: 7 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/src/tags.lisp Log: added some comments, corrected some methods for authentication, corrected some naming conventions 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 07:53:10 2008 @@ -179,15 +179,16 @@ (login-config (current-config)) (login-page (lisplet-login-page lisplet)) (server (current-server request)) - (auth-basicp (eq (lisplet-authentication-type lisplet) :basic))) - (when (and auth-basicp (null princp)) - (configuration-login login-config)) - (setf (return-code) +http-ok+ - princp (current-principal)) - (when (and login-page - (cl-ppcre:all-matches login-page uri)) - (redirect-to-https server request)) - (loop for protected-resource in protected-resources + (auth-basicp (eq (lisplet-authentication-type lisplet) :basic))) + (setf (return-code) +http-ok+) + (when login-config + (when (and auth-basicp (null princp)) + (configuration-login login-config)) + (setf princp (current-principal)) + (when (and login-page + (cl-ppcre:all-matches login-page uri)) + (redirect-to-https server request)) + (loop for protected-resource in protected-resources for match = (format nil "^~a" (car protected-resource)) for allowed-roles = (cdr protected-resource) do (when (cl-ppcre:all-matches match uri) @@ -200,9 +201,9 @@ (format nil "Basic realm=\"~A\"" (hunchentoot::quote-string (current-realm))))) (setf (return-code) +http-authorization-required+) (throw 'handler-done nil)) - (unless (loop for role in (principal-roles princp) thereis (member role allowed-roles :test #'equal)) + (unless (user-in-role-p) (setf (return-code) +http-forbidden+) - (throw 'handler-done nil))))))) + (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 07:53:10 2008 @@ -86,7 +86,7 @@ (when session (session-value 'principal session))) -(defun user-in-rolep (roles &optional (session *session*)) +(defun user-in-role-p (roles &optional (session *session*)) "Detects if current principal belongs to any of the expressed roles" (let ((principal (current-principal session))) (when principal 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 07:53:10 2008 @@ -48,7 +48,7 @@ ;:request-realm :request-id-table-map ;:dyna-id - :tag-empty-p + :tag-emptyp :tag-symbol-class :strings-to-jsarray :empty-string-p @@ -265,5 +265,5 @@ :current-lisplet :current-server :current-realm - :user-in-rolep + :user-in-role-p :login)) Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Fri Feb 15 07:53:10 2008 @@ -31,206 +31,216 @@ -(defgeneric page-req-parameter (obj name &optional as-list) +(defgeneric page-req-parameter (page name &optional as-list) (:documentation "This method returns a request parameter given by NAME searching first into post parameters and, if no parameter found, into get prarmeters. The optional function parameter AS-LIST if true returns the result as list. When AS-LIST is true, if the searched parameter is found more then once, a list with all valuse given to param NAME is returned. - - OBJ is the page instance that must be given. + - PAGE is the page instance that must be given. - NAME The parameter to search - AS-LIST If true the result is returned as list, if false as string. Default: false")) -(defgeneric page-json-id-list (obj) +(defgeneric page-json-id-list (page) (:documentation "This internal method is called to get a list of all the components by their id, that must be updated when an xhr request is sent from the browser. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-content (obj) +(defgeneric page-content (page) (:documentation "This method returns the page content to be redered. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-init (obj) +(defgeneric page-init (page) (:documentation "Internal method for page initialization. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-render (obj) +(defgeneric page-render (page) (:documentation "This method is the main method fired from the framework to render the desired page and to handle all the request cycle. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-init-injections (pobj) +(defgeneric page-init-injections (page) (:documentation "This internal method is called during the request cycle phase to reset page slots that must be reinitialized during sub-phases (rewinding, pre-rendering, rendering). - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-render-headings (obj) +(defgeneric page-render-headings (page) (:documentation "This internal method renders the html first lines that determine if the page is a html or a xhtml, along with the schema definition. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-request-parameters (obj) +(defgeneric page-request-parameters (page) (:documentation "This internal method builds the get and post parameters into an hash table. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-print-tabulation (obj) +(defgeneric page-print-tabulation (page) (:documentation "This internal method is called during the rendering phase if tabulation is enabled. It writes the right amount of tabs chars to indent the page. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-newline (obj) +(defgeneric page-newline (page) (:documentation "This internal method simply writes the rest of page content on a new line when needed. - - OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric page-format (obj str &rest rest) +(defgeneric page-format (page str &rest rest) (:documentation "This internal method is the replacement of the FORMAT function. It is aware of an xhr request when the reply must be given as a json object. It also uses the default page output stream to render the output. - - OBJ is the page instance that must be given + - PAGE is the page instance that must be given - STR The format control - REST The format arguments See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info.")) -(defgeneric page-format-raw (obj str &rest rest) +(defgeneric page-format-raw (page str &rest rest) (:documentation "This internal method is the replacement of the FORMAT. The difference with PAGE-FORMAT is that it prints out the result ignoring the json directive. It also uses the default page output stream as PAGE-FORMAT does to render the output. - - OBJ is the page instance that must be given + - PAGE is the page instance that must be given - STR The format control - REST The format arguments See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info.")) -(defgeneric page-body-init-scripts (page-obj) +(defgeneric page-body-init-scripts (page) (:documentation "During the render phase wcomponent instances inject their initialization scripts (javascript) that will be evaluated when the page has been loaded. This internal method is called to render these scripts. - - PAGE-OBJ is the page instance that must be given")) + - PAGE is the page instance that must be given")) -(defgeneric htbody-init-scripts-tag (page-obj) +(defgeneric htbody-init-scripts-tag (page) (:documentation "Encloses the init inscance scripts injected into the page into a