- Minor Range related offset fixes
authorMatthew Mondor <mmondor@pulsar-zone.net>
Tue, 11 Sep 2012 00:15:00 +0000 (00:15 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Tue, 11 Sep 2012 00:15:00 +0000 (00:15 +0000)
- HTTP-REPLY-HEADER-UNSET now accepts several keys like *-SET

mmsoftware/cl/server/httpd.lisp

index 450c31b..2ab348b 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: httpd.lisp,v 1.14 2012/09/10 22:46:51 mmondor Exp $
+;;;; $Id: httpd.lisp,v 1.15 2012/09/11 00:15:00 mmondor Exp $
 
 #|
 
@@ -69,7 +69,9 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;;;; - Possibly make all use KEEPALIVE or KEEP-ALIVE, we currently use
 ;;;;   both, which is confusing.
 ;;;; - There seems to be a bug with multiple ranges when the first range
-;;;;   is supplied a 0 start offset. XXX
+;;;;   is supplied a 0 start offset.
+;;;; - Verify why file transfers are done in 1024 byte blocks rather than
+;;;;   65536 ones.  Perhaps the underlaying stdio buffering, if any...
 
 
 
@@ -121,7 +123,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :httpd)
 
 (defparameter *rcsid*
-  "$Id: httpd.lisp,v 1.14 2012/09/10 22:46:51 mmondor Exp $")
+  "$Id: httpd.lisp,v 1.15 2012/09/11 00:15:00 mmondor Exp $")
 
 (defparameter *server-version*
   (let ((parts (string-split *rcsid*
@@ -456,11 +458,12 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (defun http-reply-header-get (reply key)
   (assoc key (http-reply-headers reply) :test #'string-equal))
 
-(defun http-reply-header-unset (reply key)
+(defun http-reply-header-unset (reply &rest keys)
   (with-accessors ((headers http-reply-headers)) reply
-    (let ((match (assoc key headers :test #'string-equal)))
-      (if match
-         (rplacd match nil))))
+    (loop
+       for key in keys
+       for match = (assoc key headers :test #'string-equal)
+       when match do (rplacd match nil)))
   (values))
 
 (defun http-reply-header-set-nocache (reply)
@@ -1676,6 +1679,7 @@ REQ is bound to VAR."
              (offset 0)
              (boundary-string nil))
          (cond (multiple-ranges-p
+
                 ;; XXX Perhaps use BASE64 instead of 16 below
                 (setf boundary-string (format nil "~64,'0X" (random #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF))
                       (http-reply-flush-signal reply) nil
@@ -1693,9 +1697,9 @@ REQ is bound to VAR."
                  (list "Content-Type" "~A; charset=~A"
                        (http-reply-mime-type reply)
                        (symbol-name (http-reply-charset reply))))
-                (http-reply-header-unset reply "Date")
-                (http-reply-header-unset reply "Last-Modified")
-                (http-reply-header-unset reply "Server"))
+                (http-reply-header-unset reply
+                  "Date" "Last-Modified" "Server"))
+
                (t
                 (setf (http-reply-code reply) 206
                       (http-reply-description reply) "Partial Content")
@@ -1704,15 +1708,13 @@ REQ is bound to VAR."
                                          (list "Content-Range"
                                                "bytes ~D-~D/~D"
                                                from to size))
-                  (http-reply-flush reply stream (- to from)))))
+                  (http-reply-flush reply stream (if (- (1+ to) from))))))
          (loop
             with orig-size = size
             with crlf = *crlf*
             for range in ranges
             for (from to) = range
-            for size = (if (= to from)
-                           1
-                           (- to from))
+            for size = (- (1+ to) from)
             when (/= offset from) do (progn
                                        (file-position in from)
                                        (setf offset from))