Author: achiumenti Date: Sat Feb 16 10:01:13 2008 New Revision: 10

Modified: trunk/main/claw-core/src/server.lisp Log: added some documentation

Modified: trunk/main/claw-core/src/server.lisp ============================================================================== --- trunk/main/claw-core/src/server.lisp (original) +++ trunk/main/claw-core/src/server.lisp Sat Feb 16 10:01:13 2008 @@ -29,55 +29,98 @@

(in-package :claw)

-(defgeneric clawserver-register-lisplet (obj lisplet-obj) +(defgeneric clawserver-register-lisplet (clawserver lisplet) (:documentation "This method registers a lisplet for request dispatching -- OBJ the CLAWSERVER instance -- LISPLET-OBJ the LISPLET instance")) +- CLAWSERVER the CLAWSERVER instance +- LISPLET the LISPLET instance"))

-(defgeneric clawserver-unregister-lisplet (obj lisplet-obj) +(defgeneric clawserver-unregister-lisplet (clawserver lisplet) (:documentation "This method unregisters a lisplet from request dispatching -- OBJ the CLAWSERVER instance -- LISPLET-OBJ the LISPLET instance")) +- CLAWSERVER the CLAWSERVER instance +- LISPLET the LISPLET instance"))

-(defgeneric clawserver-dispatch-request (obj)) ;internal -(defgeneric clawserver-dispatch-method (obj)) ;internal +(defgeneric clawserver-dispatch-request (clawserver) + (:documentation "Dispatches http requests through registered lisplets"))

-(defgeneric clawserver-start (obj) +(defgeneric clawserver-dispatch-method (clawserver) + (:documentation "Uses CLAWSERVER-DISPATCH-REQUEST to perform dispatching")) + +(defgeneric clawserver-start (clawserver) (:documentation "Starts the server")) -(defgeneric clawserver-stop (obj) + +(defgeneric clawserver-stop (clawserver) (:documentation "Stops the server"))

-(defgeneric (setf clawserver-port) (val obj)) -(defgeneric (setf clawserver-sslport) (val obj)) -(defgeneric (setf clawserver-address) (val obj)) -(defgeneric (setf clawserver-name) (val obj)) -(defgeneric (setf clawserver-sslname) (val obj)) -(defgeneric (setf clawserver-mod-lisp-p) (val obj)) -(defgeneric (setf clawserver-use-apache-log-p) (val obj)) -(defgeneric (setf clawserver-input-chunking-p) (val obj)) -(defgeneric (setf clawserver-read-timeout) (val obj)) -(defgeneric (setf clawserver-write-timeout) (val obj)) -#+(and :unix (not :win32)) (defgeneric (setf clawserver-setuid) (val obj)) -#+(and :unix (not :win32)) (defgeneric (setf clawserver-setgid) (val obj)) -#-: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 (setf clawserver-port) (port clawserver) + (:documentation "Sets the claw server http port. When server is started an error will be signaled.")) + +(defgeneric (setf clawserver-sslport) (sslport clawserver) + (:documentation "Sets the claw server https port. When server is started an error will be signaled.")) + +(defgeneric (setf clawserver-address) (address clawserver) + (:documentation "Binds the claw server to a specific address. When server is started an error will be signaled.")) + +(defgeneric (setf clawserver-name) (name clawserver) + (:documentation "Sets the name of the server that dispatches http requests.")) + +(defgeneric (setf clawserver-sslname) (sslname clawserver) + (:documentation "Sets the name of the server that dispatches https requests.")) + +(defgeneric (setf clawserver-mod-lisp-p) (mod-lisp-p clawserver) + (:documentation "When not null binds the claw server to apache using mod_lisp2. When server is started an error will be signaled.")) + +(defgeneric (setf clawserver-use-apache-log-p) (apache-log-p clawserver) + (:documentation "When boud to apache with mod_lisp2 if not nil, uses apache logging. When server is started an error will be signaled.")) + +(defgeneric (setf clawserver-input-chunking-p) (input-chunking-p clawserver) + (:documentation "Sets input-chunking-p, when true the server will accept request +bodies without a Content-Length header if the client uses chunked transfer encoding. +If you want to use this feature behind mod_lisp, you should make sure that your combination of +Apache and mod_lisp can cope with that. When server is started an error will be signaled."))

-(defgeneric configuration-login (configuration &optional request)) +(defgeneric (setf clawserver-read-timeout) (read-timeout clawserver) + (:documentation "Sets the read timeout in seconds. When server is started an error will be signaled."))

-(define-condition http-forbidden-error (error) ()) -(define-condition http-authorization-required-error (error) ()) +(defgeneric (setf clawserver-write-timeout) (write-timeout clawserver) + (:documentation "Sets the write timeout in seconds. When server is started an error will be signaled.")) + +#+(and :unix (not :win32)) (defgeneric (setf clawserver-setuid) (setuid clawserver) + (:documentation "Sets the uid under which the server runs (Only for *NIX). When server is started an error will be signaled.")) + +#+(and :unix (not :win32)) (defgeneric (setf clawserver-setgid) (setgid clawserver) + (:documentation "Sets the gid under which the server runs (Only for *NIX). When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-certificate-file) (certificate-file clawserver) + (:documentation "The ssl certificate file for https connections. When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-privatekey-file) (ssl-privatekey-file clawserver) + (:documentation "The ssl private key file for https connections. When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf clawserver-ssl-privatekey-password) (ssl-privatekey-password clawserver) + (:documentation "The password for the ssl private key file. When server is started an error will be signaled.")) + +(defgeneric clawserver-register-configuration(clawserver realm configuration) + (:documentation "Registers a configuration object for the given realm into the server. The configuration +will perform the authentication logic.")) + +(defgeneric configuration-login (configuration &optional request) + (:documentation "Authenticate a user creating a principal object that will be stored into the http session. +If no session is present one will be created, if the authentication succeds the principal instance is returned"))

(defclass error-page (page) ((title :initarg :title - :reader page-title) + :reader page-title + :documentation "The page title") (error-code :initarg :error-code - :reader page-error-code)) - (:documentation "This is the template page class used to render + :reader page-error-code + :documentation "The error code to display")) + (:documentation "This is the page class used to render the http error messages."))

-(defcomponent error-page-template () ()) +(defcomponent error-page-template () + () + (:documentation "The template for the error-page")) + (defmethod wcomponent-parameters ((error-page-template error-page-template)) (list :title :required :error-code :required :style " @@ -138,46 +181,67 @@

(defclass clawserver () ((port :initarg :port - :reader clawserver-port) + :reader clawserver-port + :documentation "Returns the claw server http port") (sslport :initarg :sslport - :reader clawserver-sslport) + :reader clawserver-sslport + :documentation "Returns the claw server https port") (address :initarg :address - :reader clawserver-address) + :reader clawserver-address + :documentation "Returns the address where claw server is bound to.") (name :initarg :name - :reader clawserver-name) + :reader clawserver-name + :documentation "Returns the name of the server that dispatches http requests.") (sslname :initarg :sslname - :reader clawserver-sslname) + :reader clawserver-sslname + :documentation "Returns the name of the server that dispatches https requests.") (mod-lisp-p :initarg :mod-lisp-p - :reader clawserver-mod-lisp-p) + :reader clawserver-mod-lisp-p + :documentation "Returns not nil when the server is bound to apache through mod_lisp") (use-apache-log-p :initarg :use-apache-log-p - :reader clawserver-use-apache-log-p) + :reader clawserver-use-apache-log-p + :documentation "Returns not nil when the server uses apache logging") (input-chunking-p :initarg :input-chunking-p - :reader clawserver-input-chunking-p) + :reader clawserver-input-chunking-p + :documentation "When true the server will accept request +bodies without a Content-Length header if the client uses chunked transfer encoding. +If you want to use this feature behind mod_lisp, you should make sure that your combination of +Apache and mod_lisp can cope with that.") (read-timeout :initarg :read-timeout - :reader clawserver-read-timeout) + :reader clawserver-read-timeout + :documentation "Returns the server read timeout in seconds.") (write-timeout :initarg :write-timeout - :reader clawserver-write-timeout) + :reader clawserver-write-timeout + :documentation "Returns the server write timeout in seconds.") (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 +expressed as string, and a predicate. The predicate should take two arguments (login and password), and return a principal instance if the login call succeeds.") #+(and :unix (not :win32)) (setuid :initarg :setuid - :reader clawserver-setuid) + :reader clawserver-setuid + :documentation "Returns the uid under which the server runs.") #+(and :unix (not :win32)) (setgid :initarg :setgid - :reader clawserver-setgid) + :reader clawserver-setgid + :documentation "Returns the gid under which the server runs.") #-:hunchentoot-no-ssl (ssl-certificate-file :initarg :ssl-certificate-file - :reader clawserver-ssl-certificate-file) + :reader clawserver-ssl-certificate-file + :documentation "The ssl certificate file for https connections.") #-:hunchentoot-no-ssl (ssl-privatekey-file :initarg :ssl-privatekey-file - :reader clawserver-ssl-privatekey-file) + :reader clawserver-ssl-privatekey-file + :documentation "The ssl private key file for https connections") #-:hunchentoot-no-ssl (ssl-privatekey-password :initarg :ssl-privatekey-password - :reader clawserver-ssl-privatekey-password) + :reader clawserver-ssl-privatekey-password + :documentation "The password for the ssl private key file for https connections") (server :initform nil - :accessor clawserver-server) + :accessor clawserver-server + :documentation "The hunchentoot server dispatching http requests.") (sslserver :initform nil - :accessor clawserver-sslserver) + :accessor clawserver-sslserver + :documentation "The hunchentoot server dispatching https requests.") (lisplets :initform nil - :accessor clawserver-lisplets)) + :accessor clawserver-lisplets + :documentation "A collection of cons where the car is an url location where a lisplet is registered and the cdr is a dispatcher for that lisplet")) (:default-initargs :address nil :name (gensym) :sslname (gensym) @@ -212,33 +276,33 @@ (: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) +(defmethod initialize-instance :after ((clawserver clawserver) &rest keys) (let ((use-apache-log-p (getf keys :use-apache-log-p :undefined)) #-:hunchentoot-no-ssl (ssl-privatekey-file (getf keys :ssl-privatekey-file :undefined))) (when (eq use-apache-log-p :undefined) - (setf (clawserver-use-apache-log-p obj) (getf keys :mod-lisp-p))) + (setf (clawserver-use-apache-log-p clawserver) (getf keys :mod-lisp-p))) #-:hunchentoot-no-ssl (when (eq ssl-privatekey-file :undefined) - (setf (clawserver-ssl-privatekey-file obj) (getf keys :ssl-certificate-file))))) + (setf (clawserver-ssl-privatekey-file clawserver) (getf keys :ssl-certificate-file)))))

-(defmethod clawserver-register-lisplet ((obj clawserver) (lisplet-obj lisplet)) - (let ((lisplets (clawserver-lisplets obj)) +(defmethod clawserver-register-lisplet ((clawserver clawserver) (lisplet lisplet)) + (let ((lisplets (clawserver-lisplets clawserver)) (server-base-path *clawserver-base-path*) - (location (lisplet-base-path lisplet-obj))) + (location (lisplet-base-path lisplet))) (unless (null server-base-path) (setf location (format nil "~@[~a~]~a" server-base-path location))) - (setf (clawserver-lisplets obj) (sort-dispatchers (push-location-cons + (setf (clawserver-lisplets clawserver) (sort-dispatchers (push-location-cons (cons location (create-prefix-dispatcher location #'(lambda () - (lisplet-dispatch-method lisplet-obj)) - (lisplet-realm lisplet-obj))) + (lisplet-dispatch-method lisplet)) + (lisplet-realm lisplet))) lisplets)))))

-(defmethod clawserver-unregister-lisplet ((obj clawserver) (lisplet-obj lisplet)) - (let ((lisplets (clawserver-lisplets obj)) +(defmethod clawserver-unregister-lisplet ((clawserver clawserver) (lisplet lisplet)) + (let ((lisplets (clawserver-lisplets clawserver)) (server-base-path *clawserver-base-path*) - (location (lisplet-base-path lisplet-obj))) + (location (lisplet-base-path lisplet))) (unless (null server-base-path) (setf location (format nil "~@[~a~]~a" server-base-path location))) (remove-by-location location lisplets))) @@ -246,122 +310,122 @@

;;;-------------------------- WRITERS ----------------------------------------

-(defmethod (setf clawserver-port) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-port) (port (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change port when server is started")) - (setf (slot-value obj 'port) val)) + (setf (slot-value clawserver 'port) port))

-(defmethod (setf clawserver-sslport) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-sslport) (sslport (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change SSL port when server is started")) - (setf (slot-value obj 'sslport) val)) + (setf (slot-value clawserver 'sslport) sslport))

-(defmethod (setf clawserver-address) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-address) (address (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change binding address when server is started")) - (setf (slot-value obj 'address) val)) + (setf (slot-value clawserver 'address) address))

-(defmethod (setf clawserver-name) (val (obj clawserver)) - (unless (null (clawserver-server obj)) - (setf (server-name (clawserver-server obj)) val)) - (setf (slot-value obj 'name) val)) - -(defmethod (setf clawserver-sslname) (val (obj clawserver)) - (unless (null (clawserver-sslserver obj)) - (setf (server-name (clawserver-sslserver obj)) val)) - (setf (slot-value obj 'sslname) val)) +(defmethod (setf clawserver-name) (name (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) + (setf (server-name (clawserver-server clawserver)) name)) + (setf (slot-value clawserver 'name) name)) + +(defmethod (setf clawserver-sslname) (sslname (clawserver clawserver)) + (unless (null (clawserver-sslserver clawserver)) + (setf (server-name (clawserver-sslserver clawserver)) sslname)) + (setf (slot-value clawserver 'sslname) sslname))

-(defmethod (setf clawserver-mod-lisp-p) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-mod-lisp-p) (mod-lisp-p (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change mod-lisp property when server is started")) - (setf (slot-value obj 'mod-lisp-p) val)) + (setf (slot-value clawserver 'mod-lisp-p) mod-lisp-p))

-(defmethod (setf clawserver-use-apache-log-p) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-use-apache-log-p) (use-apache-log-p (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change logging property when server is started")) - (setf (slot-value obj 'use-apache-log-p) val)) + (setf (slot-value clawserver 'use-apache-log-p) use-apache-log-p))

-(defmethod (setf clawserver-input-chunking-p) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-input-chunking-p) (input-chunking-p (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change chunking property when server is started")) - (setf (slot-value obj 'input-chunking-p) val)) + (setf (slot-value clawserver 'input-chunking-p) input-chunking-p))

-(defmethod (setf clawserver-read-timeout) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-read-timeout) (read-timeout (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change read timeout property when server is started")) - (setf (slot-value obj 'read-timeout) val)) + (setf (slot-value clawserver 'read-timeout) read-timeout))

-(defmethod (setf clawserver-write-timeout) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +(defmethod (setf clawserver-write-timeout) (write-timeout (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change write timeout property when server is started")) - (setf (slot-value obj 'write-timeout) val)) + (setf (slot-value clawserver 'write-timeout) write-timeout))

-#+(and :unix (not :win32)) (defmethod (setf clawserver-setuid) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +#+(and :unix (not :win32)) (defmethod (setf clawserver-setuid) (setuid (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change uid property when server is started")) - (setf (slot-value obj 'setuid) val)) + (setf (slot-value clawserver 'setuid) setuid))

-#+(and :unix (not :win32)) (defmethod (setf clawserver-setgid) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +#+(and :unix (not :win32)) (defmethod (setf clawserver-setgid) (setgid (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change gid property when server is started")) - (setf (slot-value obj 'setgid) val)) + (setf (slot-value clawserver 'setgid) setgid))

-#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-certificate-file) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-certificate-file) (ssl-certificate-file (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change ssl certificate file property when server is started")) - (setf (slot-value obj 'ssl-certificate-file) val)) + (setf (slot-value clawserver 'ssl-certificate-file) ssl-certificate-file))

-#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-privatekey-file) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-privatekey-file) (ssl-privatekey-file (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change ssl privatekey file property when server is started")) - (setf (slot-value obj 'ssl-privatekey-file) val)) + (setf (slot-value clawserver 'ssl-privatekey-file) ssl-privatekey-file))

-#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-privatekey-password) (val (obj clawserver)) - (unless (null (clawserver-server obj)) +#-:hunchentoot-no-ssl (defmethod (setf clawserver-ssl-privatekey-password) (ssl-privatekey-password (clawserver clawserver)) + (unless (null (clawserver-server clawserver)) (error "Cannot change ssl privatekey password property when server is started")) - (setf (slot-value obj 'ssl-privatekey-password) val)) + (setf (slot-value clawserver 'ssl-privatekey-password) ssl-privatekey-password))

;;;-------------------------- 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))) +(defmethod clawserver-dispatch-request ((clawserver clawserver)) + (let ((lisplets (clawserver-lisplets clawserver))) (loop for dispatcher in lisplets for action = (funcall (cdr dispatcher) *request*) when action return (funcall action))))

-(defmethod clawserver-dispatch-method ((obj clawserver)) +(defmethod clawserver-dispatch-method ((clawserver clawserver)) (let ((result nil)) (progn - (setf (aux-request-value 'clawserver) obj) - (setf result (clawserver-dispatch-request obj)) + (setf (aux-request-value 'clawserver) clawserver) + (setf result (clawserver-dispatch-request clawserver)) (if (null result) #'(lambda () (when (= (return-code) +http-ok+) (setf (return-code *reply*) +http-not-found+))) #'(lambda () result)))))

-(defmethod clawserver-start ((obj clawserver)) - (let ((port (clawserver-port obj)) - (sslport (clawserver-sslport obj)) - (address (clawserver-address obj)) +(defmethod clawserver-start ((clawserver clawserver)) + (let ((port (clawserver-port clawserver)) + (sslport (clawserver-sslport clawserver)) + (address (clawserver-address clawserver)) (dispatch-table (list #'(lambda (request) (declare (ignorable request)) - (clawserver-dispatch-method obj)))) - (name (clawserver-name obj)) - (sslname (clawserver-sslname obj)) - (mod-lisp-p (clawserver-mod-lisp-p obj)) - (use-apache-log-p (clawserver-use-apache-log-p obj)) - (input-chunking-p (clawserver-input-chunking-p obj)) - (read-timeout (clawserver-read-timeout obj)) - (write-timeout (clawserver-write-timeout obj)) - (uid (clawserver-setuid obj)) - (gid (clawserver-setgid obj)) - (ssl-certificate-file (clawserver-ssl-certificate-file obj)) - (ssl-privatekey-file (clawserver-ssl-privatekey-file obj)) - (ssl-privatekey-password (clawserver-ssl-privatekey-password obj))) + (clawserver-dispatch-method clawserver)))) + (name (clawserver-name clawserver)) + (sslname (clawserver-sslname clawserver)) + (mod-lisp-p (clawserver-mod-lisp-p clawserver)) + (use-apache-log-p (clawserver-use-apache-log-p clawserver)) + (input-chunking-p (clawserver-input-chunking-p clawserver)) + (read-timeout (clawserver-read-timeout clawserver)) + (write-timeout (clawserver-write-timeout clawserver)) + (uid (clawserver-setuid clawserver)) + (gid (clawserver-setgid clawserver)) + (ssl-certificate-file (clawserver-ssl-certificate-file clawserver)) + (ssl-privatekey-file (clawserver-ssl-privatekey-file clawserver)) + (ssl-privatekey-password (clawserver-ssl-privatekey-password clawserver))) (progn - (setf (clawserver-server obj) + (setf (clawserver-server clawserver) (start-server :port port :address address :dispatch-table dispatch-table @@ -374,7 +438,7 @@ #+(and :unix (not :win32)) :setuid uid #+(and :unix (not :win32)) :setgid gid)) #-:hunchentoot-no-ssl (when ssl-certificate-file - (setf (clawserver-sslserver obj) + (setf (clawserver-sslserver clawserver) (start-server :port sslport :address address :dispatch-table dispatch-table @@ -390,20 +454,21 @@ :ssl-privatekey-file ssl-privatekey-file :ssl-privatekey-password ssl-privatekey-password))))))

-(defmethod clawserver-stop ((obj clawserver)) +(defmethod clawserver-stop ((clawserver clawserver)) (progn - (setf (clawserver-server obj) (stop-server (clawserver-server obj))) - (when (clawserver-sslserver obj) - (setf (clawserver-sslserver obj) (stop-server (clawserver-sslserver obj)))))) + (setf (clawserver-server clawserver) (stop-server (clawserver-server clawserver))) + (when (clawserver-sslserver clawserver) + (setf (clawserver-sslserver clawserver) (stop-server (clawserver-sslserver clawserver)))))) ;;;---------------------------------------------------------------------------- (defun login (&optional (request *request*)) + "Perform user authentication for the reaml where the request has been created" (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 +(defun start-clawserver (clawserver &key (port 80) address (name (gensym)) @@ -421,7 +486,7 @@ :address address :dispatch-table (list #'(lambda (request) (declare (ignorable request)) - (clawserver-dispatch-method clawserver-obj))) + (clawserver-dispatch-method clawserver))) :name name :mod-lisp-p mod-lisp-p :use-apache-log-p use-apache-log-p @@ -434,29 +499,3 @@ #-:hunchentoot-no-ssl :ssl-privatekey-file ssl-privatekey-file #-:hunchentoot-no-ssl :ssl-privatekey-password ssl-privatekey-password)) -#| - (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