From eac484a06f87ec570335c36e37bfd457d5256878 Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Fri, 21 Jul 2000 23:22:25 +0000 Subject: [PATCH] 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 | 105 ++++++++++++++++++++++++--------------------- 1 file changed, 56 insertions(+), 49 deletions(-) diff --git a/src/main/entity.cl b/src/main/entity.cl index 7a2c465..c62201f 100644 --- a/src/main/entity.cl +++ b/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))))