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

Moved render-slots to messages.cl, removed non-1.0 entity-headers,
and implemented the rest.  Added a number of ready-made entity
implementations, for use with static-resource.

src/main/entity.cl

@@ -22,7 +22,6 @@
 
 (defclass entity-header-mixin/1.1 ()
   ((allow :initarg :allow :reader entity-allow)
-   (content-base :initarg :content-base :reader entity-content-base)
    (content-encoding :initarg :content-encoding
 		     :reader entity-content-encoding)
    (content-language :initarg :content-language
@@ -33,37 +32,13 @@
    (content-md5 :initarg :content-md5 :reader entity-content-md5)
    (content-range :initarg :content-range :reader entity-content-range)
    (content-type :initarg :content-type :reader entity-content-type)
-   (etag :initarg :etag :reader entity-etag)
    (expires :initarg :expires :reader entity-expires)
    (last-modified :initarg :last-modified :reader entity-last-modified)))
 
-(defmacro render-slots ((obj stream) &rest clauses)
-  (loop with obj-sym = (gensym)
-	with stream-sym = (gensym)
-	for (slot-spec string . body) in clauses
-	for slot = (if (consp slot-spec) (car slot-spec) slot-spec)
-	for slot-var = (if (consp slot-spec) (cadr slot-spec) slot-spec)
-	collect
-	`(when (slot-boundp ,obj-sym (quote ,slot))
-	   (with-slots ((,slot-var ,slot)) ,obj-sym
-	     (write-string ,string ,stream-sym)
-	     (write-char #\: ,stream-sym)
-	     (write-char #\Space ,stream-sym)
-	     ,@body
-	     (write-char #\Return ,stream-sym)
-	     (write-char #\Newline ,stream-sym)))
-	into clause-list
-	finally
-	(return `(let ((,stream-sym ,stream)
-		       (,obj-sym ,obj))
-		   ,@clause-list))))
-
 (defmethod render-entity-headers ((e entity-header-mixin/1.1) stream)
   (render-slots (e stream)
     (allow "Allow"
       (write-http-element-list-1 allow stream))
-    (content-base "Content-Base"
-      (princ content-base stream))
     (content-encoding "Content-Encoding"
       (write-http-element-list-1 content-encoding stream))
     (content-language "Content-Language"
@@ -78,35 +53,67 @@
     #+NIL
     (content-range "Content-Range"
       (princ content-range stream))
-    #+NIL
     (content-type "Content-Type"
       (princ content-type stream))
-    #+NIL
-    (etag "ETag"
-      (princ etag stream))
-    #+NIL
     (expires "Expires"
-      (princ expires stream))
-    #+NIL
+      (write-string (rfc1123-format-time expires) stream))
     (last-modified "Last-Modified"
-      (princ last-modified stream))))
+      (write-string (rfc1123-format-time last-modified) stream))))
 
+(defclass stream-entity-mixin ()
+  ())
 
+(defgeneric stream-entity-stream (entity))
 
-(defclass simple-entity (entity entity-header-mixin/1.1)
-  ((body :initarg :body :reader entity-body :initform nil)))
+(defgeneric stream-entity-length (entity))
+
+(defmethod render-entity-headers :before ((e stream-entity-mixin) stream)
+  (setf (slot-value e 'content-length) (stream-entity-length e)))
+
+(defmethod render-entity-body ((entity stream-entity-mixin) stream)
+  (with-open-stream (in-stream (stream-entity-stream entity))
+    (with-io-buffer (buffer)
+      (loop for length = (read-sequence buffer in-stream)
+	    until (zerop length)
+	    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
+	(setf (slot-value entity 'file-stream)
+	      (open (entity-pathname entity) :direction :input)))))
+
+(defclass cached-entity-mixin ()
+  ((body-cache)))
+
+(defmethod render-entity-body :around ((entity cached-entity-mixin) stream)
+  (prog1 nil
+    (if (slot-boundp entity 'body-cache)
+	(write-sequence (slot-value entity 'body-cache) stream)
+	(setf (slot-value entity 'body-cache)
+	      (with-output-to-string (cache-stream)
+		(with-open-stream (combined-stream
+				   (make-broadcast-stream stream cache-stream))
+		  (call-next-method entity combined-stream)))))))
+
+(defclass cached-file-entity (cached-entity-mixin file-entity)
+  ())
 
-(defmethod render-entity-body ((entity simple-entity) stream)
-  (etypecase (entity-body entity)
-    (string
-     (with-input-from-string (in-stream (entity-body entity))
-       (loop for line = (read-line in-stream nil nil)
-	     while line
-	     do (write-http-line line stream))))
-    (pathname
-     (with-open-file (in-stream (entity-body entity))
-       (let ((buffer (make-string (file-length in-stream))))
-	 (+ (read-sequence buffer in-stream)
-	    (length (write-sequence buffer stream))))))
-    (function
-     (funcall (entity-body entity) stream))))