From a9e2f4c55324717803f4c80e43f836b605a9da8d Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Sat, 22 Jul 2000 00:34:37 +0000 Subject: [PATCH] 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. --- src/main/resource.cl | 65 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 52 insertions(+), 13 deletions(-) diff --git a/src/main/resource.cl b/src/main/resource.cl index d8702ae..8b37f36 100644 --- a/src/main/resource.cl +++ b/src/main/resource.cl @@ -19,29 +19,68 @@ (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) (let ((method (request-method request)) (allowed-methods (resource-allowed-methods resource))) (if (member method allowed-methods) (access-resource-using-method resource request method) - (create-response request - +HTTP-Code-Method-Not-Allowed+ - (make-instance 'simple-entity - :allow allowed-methods))))) + (error 'clash-error :code +HTTP-Code-Method-Not-Allowed+ + :entity-initargs (list :allow allowed-methods))))) -(defclass simple-resource (resource) - ((content :initarg :content :accessor simple-resource-content) - (allowed-methods :allocation :class :initform '(:GET) +(defclass static-resource (resource) + ((entity :initarg :entity :accessor static-resource-entity) + (allowed-methods :allocation :class :initform '(:GET :HEAD) :reader resource-allowed-methods))) (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+ :entity - (make-instance 'simple-entity - :body - (simple-resource-content resource)))) + (static-resource-entity 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)))))