Changes that bring CLASH up to extended HTTP/1.0 support:

Changed argument precedence order on access-resource and
access-resource-using-method to implement the expected semantics that
methods specialized on requests or request-methods overide more
general methods in base classes.

Also revamped the division of labour between entities and resources on
static resources (see entity.cl), so that static resources are simple
wrappers around static entities, which provide the content.

Added resources that handle dynamic content and forms by dispatching
to functions passed in during creation.  This is to support simple
ad-hoc dynamic resources, whereas really dynamic resources will just
subclass resource and implement the stuff on their own.

Added a simple wrapper to bind form data passed in with a post request
(with-form-data).  This should be unified with query-argument
processing.
This commit is contained in:
2000-07-22 00:34:37 +00:00
parent 22b8cd9c8f
commit a9e2f4c553

View File

@ -19,29 +19,68 @@
(defgeneric resource-allowed-methods (resource)) (defgeneric resource-allowed-methods (resource))
(defgeneric access-resource (resource request)) (defgeneric access-resource (resource request)
(:argument-precedence-order request resource))
(defgeneric access-resource-using-method (resource request method)) (defgeneric access-resource-using-method (resource request method)
(:argument-precedence-order method request resource))
(defmethod access-resource ((resource resource) request) (defmethod access-resource ((resource resource) request)
(let ((method (request-method request)) (let ((method (request-method request))
(allowed-methods (resource-allowed-methods resource))) (allowed-methods (resource-allowed-methods resource)))
(if (member method allowed-methods) (if (member method allowed-methods)
(access-resource-using-method resource request method) (access-resource-using-method resource request method)
(create-response request (error 'clash-error :code +HTTP-Code-Method-Not-Allowed+
+HTTP-Code-Method-Not-Allowed+ :entity-initargs (list :allow allowed-methods)))))
(make-instance 'simple-entity
:allow allowed-methods)))))
(defclass simple-resource (resource) (defclass static-resource (resource)
((content :initarg :content :accessor simple-resource-content) ((entity :initarg :entity :accessor static-resource-entity)
(allowed-methods :allocation :class :initform '(:GET) (allowed-methods :allocation :class :initform '(:GET :HEAD)
:reader resource-allowed-methods))) :reader resource-allowed-methods)))
(defmethod access-resource-using-method (defmethod access-resource-using-method
((resource simple-resource) request (method (eql :GET))) ((resource static-resource) request (method (eql :GET)))
(create-response request +HTTP-Code-OK+ (create-response request +HTTP-Code-OK+
:entity :entity
(make-instance 'simple-entity (static-resource-entity resource)))
:body
(simple-resource-content resource)))) (defmethod access-resource-using-method
((resource static-resource) request (method (eql :HEAD)))
(create-response request +HTTP-Code-OK+
:entity
(static-resource-entity resource)))
(defclass dynamic-resource (resource)
((allowed-methods :initarg :allowed-methods
:initform '(:GET :HEAD)
:reader resource-allowed-methods)
(generator :initarg :generator :reader dynamic-resource-generator)))
(defmethod access-resource-using-method
((resource dynamic-resource) request method)
(funcall (dynamic-resource-generator resource) resource request method))
(defclass dynamic-form-resource (dynamic-resource)
((processor :initarg :processor :reader dynamic-form-resource-processor))
(:default-initargs :allowed-methods '(:GET :HEAD :POST)))
(defmethod access-resource-using-method
((resource dynamic-form-resource) request (method (eql :POST)))
(funcall (dynamic-form-resource-processor resource) resource request method))
(defun parse-form-data (request)
(let* ((entity (request-entity request))
(data (entity-body entity)))
(parse-query-part data 0 (length data))))
(defmacro with-form-data (vars request &body body)
(loop with data-sym = (gensym)
for var in vars
collect
`(,var (cdr (assoc (symbol-name ',var) ,data-sym
:test #'string-equal)))
into bindings
finally
(return `(let ((,data-sym (parse-form-data ,request)))
(let ,bindings
,@body)))))