[claw-cvs] r10 - trunk/main/claw-core/src
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Sat Feb 16 15:01:16 UTC 2008
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
More information about the Claw-cvs
mailing list