Backed out the last, misguided change to entity.cl (what was I

thinking?) and rewrote the whole outbound entity stuff instead.  This
fixes some of the problems, but the whole entity stuff really needs a
complete rethink, especially w.r.t. integrating inbound and outbound
entities.  Maybe we should drop "intelligent", persistent entities
completely, and revert to dumb, transient entities, with the
intelligence lying in the resources.

src/main/entity.cl

@@ -22,9 +22,19 @@
    "Given a parsed HTTP header-list, compute the initargs that will be
 used to call `reinitialize-instance' on the entity."))
 
-(defgeneric render-entity-headers (entity stream))
+(defgeneric update-entity-headers (entity)
+  (:method-combination progn)
+  (:documentation
+   "Update the entity's headers to reflect the current state of the entity."))
 
-(defgeneric render-entity-body (entity stream))
+(defgeneric render-entity-headers (entity stream)
+  (:method-combination progn)
+  (:documentation
+   "Render the entity's headers to the given stream."))
+
+(defgeneric render-entity-body (entity stream)
+  (:documentation
+   "Render the entity's body to the given stream."))
 
 (defclass entity-header-mixin/1.1 ()
   ((allow :initarg :allow :reader entity-allow)
@@ -58,7 +68,7 @@ used to call `reinitialize-instance' on the entity."))
     (:expires (parse-http-date v))
     (:last-modified (parse-http-date v))))
 
-(defmethod render-entity-headers ((e entity-header-mixin/1.1) stream)
+(defmethod render-entity-headers progn ((e entity-header-mixin/1.1) stream)
   (render-slots (e stream)
     (allow "Allow"
       (write-http-element-list-1 allow stream))
@@ -85,20 +95,31 @@ used to call `reinitialize-instance' on the entity."))
     (last-modified "Last-Modified"
       (write-string (rfc1123-format-time last-modified) stream))))
 
-(defclass stream-entity-mixin ()
+;;; Strings as entities
-  ())
 
-(defgeneric stream-entity-stream (entity))
+(defclass string-entity (entity entity-header-mixin/1.1)
+  ((body :initarg :body :reader entity-body)))
 
-(defgeneric stream-entity-length (entity))
+(defmethod update-entity-headers progn ((entity string-entity))
+  (setf (slot-value entity 'content-length) (length (entity-body entity))))
 
-(defmethod render-entity-headers :before ((e stream-entity-mixin) stream)
+(defmethod render-entity-body ((entity string-entity) stream)
-  (declare (ignore stream))
-  (setf (slot-value e 'content-length) (stream-entity-length e)))
-
-(defmethod render-entity-body ((entity stream-entity-mixin) stream)
   (declare (type stream stream))
-  (with-open-stream (in-stream (stream-entity-stream entity))
+  (write-sequence (entity-body entity) stream))
+
+;;; Files as entities
+
+(defclass file-entity (entity entity-header-mixin/1.1)
+  ((pathname :initarg :pathname :reader entity-pathname)))
+
+(defmethod update-entity-headers progn ((entity file-entity))
+  (with-open-file (stream (entity-pathname entity))
+    (setf (slot-value entity 'content-length) (file-length stream)
+	  (slot-value entity 'last-modified) (file-write-date stream))))
+
+(defmethod render-entity-body ((entity file-entity) stream)
+  (declare (type stream stream))
+  (with-open-file (in-stream (entity-pathname entity))
     (declare (type stream in-stream))
     (with-io-buffer (buffer)
       (loop for length of-type fixnum = (read-sequence buffer in-stream)
@@ -106,43 +127,31 @@ used to call `reinitialize-instance' on the entity."))
 	    do
 	    (write-sequence buffer stream :end length)))))
 
-(defclass string-entity (entity stream-entity-mixin entity-header-mixin/1.1)
-  ((body :initarg :body :reader entity-body)))
-
-(defmethod stream-entity-length ((entity string-entity))
-  (length (entity-body entity)))
-
-(defmethod stream-entity-stream ((entity string-entity))
-  (make-string-input-stream (entity-body entity)))
-
-(defclass file-entity (entity stream-entity-mixin entity-header-mixin/1.1)
-  ((pathname :initarg :pathname :reader entity-pathname)
-   (file-stream :initform nil)))
-
-(defmethod stream-entity-length ((entity file-entity))
-  (file-length (stream-entity-stream entity)))
-
-(defmethod stream-entity-stream ((entity file-entity))
-  (let ((file-stream (slot-value entity 'file-stream)))
-    (if (and (streamp file-stream) (open-stream-p file-stream))
-	file-stream
-	(let ((stream (open (entity-pathname entity) :direction :input)))
-	  (setf (slot-value entity 'last-modified) (file-write-date stream)
-		(slot-value entity 'file-stream) stream)
-	  stream))))
-
 (defclass cached-entity-mixin ()
-  ((rendered-body)))
+  ((rendered-headers)
+   (rendered-body)))
+
+(defmethod update-entity-headers :around ((entity cached-entity-mixin))
+  (unless (slot-boundp entity 'rendered-headers)
+    (call-next-method)))
+
+(defmethod render-entity-headers :around ((entity cached-entity-mixin) stream)
+  (if (slot-boundp entity 'rendered-headers)
+      (write-sequence (slot-value entity 'rendered-headers) stream)
+      (setf (slot-value entity 'rendered-headers)
+	    (with-output-to-string (cache-stream)
+	      (with-open-stream (combined-stream
+				 (make-broadcast-stream stream cache-stream))
+		(call-next-method entity combined-stream))))))
 
 (defmethod render-entity-body :around ((entity cached-entity-mixin) stream)
-  (prog1 nil
+  (if (slot-boundp entity 'rendered-body)
-    (if (slot-boundp entity 'rendered-body)
+      (write-sequence (slot-value entity 'rendered-body) stream)
-	(write-sequence (slot-value entity 'rendered-body) stream)
+      (setf (slot-value entity 'rendered-body)
-	(setf (slot-value entity 'rendered-body)
+	    (with-output-to-string (cache-stream)
-	      (with-output-to-string (cache-stream)
+	      (with-open-stream (combined-stream
-		(with-open-stream (combined-stream
+				 (make-broadcast-stream stream cache-stream))
-				   (make-broadcast-stream stream cache-stream))
+		(call-next-method entity combined-stream))))))
-		  (call-next-method entity combined-stream)))))))
 
 (defclass cached-file-entity (cached-entity-mixin file-entity)
   ())

src/main/resource.cl

@@ -32,6 +32,8 @@
       (error 'clash-error :code +HTTP-Code-Method-Not-Allowed+
 	     :entity-initargs (list :allow allowed-methods)))
     (let ((response (access-resource-using-method resource request method)))
+      (when (slot-boundp response 'entity)
+	(update-entity-headers (http-message-entity response)))
       ;; Handle Conditional-Get as per RFC 1945
       (when (and (eq method :GET)
 		 (header-exists-p request 'if-modified-since)