Pierre R. Mai
a9e2f4c553
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.
87 lines
2.8 KiB
Common Lisp
87 lines
2.8 KiB
Common Lisp
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
|
;;;; This is copyrighted software. See documentation for terms.
|
|
;;;;
|
|
;;;; resource.cl --- Definition of a served resource
|
|
;;;;
|
|
;;;; Checkout Tag: $Name$
|
|
;;;; $Id$
|
|
|
|
(in-package :CLASH)
|
|
|
|
;;;; %File Description:
|
|
;;;;
|
|
;;;; A resource is that which is accessed by a client through a server
|
|
;;;; via an URL ;)
|
|
;;;;
|
|
|
|
(defclass resource ()
|
|
())
|
|
|
|
(defgeneric resource-allowed-methods (resource))
|
|
|
|
(defgeneric access-resource (resource request)
|
|
(:argument-precedence-order request resource))
|
|
|
|
(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)
|
|
(error 'clash-error :code +HTTP-Code-Method-Not-Allowed+
|
|
:entity-initargs (list :allow allowed-methods)))))
|
|
|
|
(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 static-resource) request (method (eql :GET)))
|
|
(create-response request +HTTP-Code-OK+
|
|
:entity
|
|
(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)))))
|