v1.3.33: speed up serving of files

Send file content in large chunks so that stream code won't store the
data in its own buffers before sending.

Change-Id: I93f67d8189befd42908e01985322d7d00358f55b

main.cl

@@ -38,7 +38,7 @@
 #+ignore
 (check-smp-consistency)
 
-(defparameter *aserve-version* '(1 3 32))
+(defparameter *aserve-version* '(1 3 33))
 
 (eval-when (eval load)
     (require :sock)

packages.cl

@@ -1,6 +1,8 @@
 #+(version= 9 0)
-(sys:defpatch "aserve" 15
-  "v15: 1.3.32: add no-proxy argument to do-http-request. Fix buggy argument checking for ssl arguments ;
+(sys:defpatch "aserve" 16
+
+  "v16: 1.3.33: speed up serving of files;
+v15: 1.3.32: add no-proxy argument to do-http-request. Fix buggy argument checking for ssl arguments ;
 v14: 1.3.30: For https, use defaults of the underlying ssl module;
 v13: 1.3.29: proxy now returns content-length;
 v12: 1.3.28: Fix bug in retry-on-timeout code in do-http-request;
@@ -20,8 +22,9 @@ v1: 1.3.16: fix freeing freed buffer."
   :post-loadable t)
 
 #+(version= 8 2)
-(sys:defpatch "aserve" 27
-  "v27: 1.3.32: add no-proxy argument to do-http-request. Fix buggy argument checking for ssl arguments;
+(sys:defpatch "aserve" 28
+  "v28: 1.3.33: speed up serving of files;
+v27: 1.3.32: add no-proxy argument to do-http-request. Fix buggy argument checking for ssl arguments;
 v26: 1.3.30: For https, use defaults of the underlying ssl module.
 v25: 1.3.29: proxy now returns content-length;
 v24: 1.3.28: Fix bug in retry-on-timeout code in do-http-request;

publish.cl

@@ -1540,6 +1540,27 @@
 
 
 
+; this is stack allocated so don't make it too big
+(defparameter *send-buffer-lock* (mp:make-process-lock))
+(defconstant  *send-buffer-size* #.(* 16 1024))
+
+(defvar *send-buffers* nil)
+
+(defun alloc-send-buffer ()
+  (mp:with-process-lock (*send-buffer-lock*)
+    (let ((buff (pop *send-buffers*)))
+      (if* buff
+	 thenret
+	 else (make-array *send-buffer-size* :element-type '(unsigned-byte 8))))))
+
+(defun free-send-buffer (buffer)
+  (mp:with-process-lock (*send-buffer-lock*)
+    (push buffer *send-buffers*)))
+
+
+
+
+
 (defun send-file-back (req ent filename encoding cache-ok)
   (let (p range)
 
@@ -1561,11 +1582,7 @@
 	  (let ((size (excl::filesys-size (stream-input-fn p)))
 		(lastmod (excl::filesys-write-date 
 			  (stream-input-fn p)))
-		(buffer (make-array 1024 
-				    :element-type '(unsigned-byte 8))))
-	    (declare (dynamic-extent buffer))
-
-
+		(buffer nil))
 
 
 	    (setf (last-modified ent) lastmod
@@ -1584,6 +1601,9 @@
 		    (return-from send-file-back :retry))
 
 
+
+	    (setq buffer (alloc-send-buffer))
+
 	    (if* (setq range (header-slot-value req :range))
 	       then (setq range (parse-range-value range))
 		    (if* (not (eql (length range) 1))
@@ -1594,9 +1614,12 @@
 			    (setq range nil)))
 	    (if* range
 	       then (return-from send-file-back
-		      (return-file-range-response
-		       req ent range buffer p size)))
-
+		      (prog1 (return-file-range-response
+			      req ent range buffer p size)
+			(free-send-buffer buffer))))
+
+
+
 
 	    (with-http-response (req ent :format :binary)
 
@@ -1616,17 +1639,25 @@
 
 
 	      (run-entity-hook req ent nil)
-
+
+
+
+
 	      (with-http-body (req ent)
 		(loop
 		  (if* (<= size 0) then (return))
 		  (let ((got (read-sequence buffer 
 					    p :end 
-					    (min size 1024))))
+					    (min size (length buffer)))))
 		    (if* (<= got 0) then (return))
 		    (write-sequence buffer (request-reply-stream req)
 				    :end got)
-		    (decf size got)))))))
+		    (decf size got))))
+
+
+	      (free-send-buffer buffer)
+
+	      )))
 
 
 
@@ -1681,7 +1712,7 @@
 		  (loop
 		    (if* (<= left 0) then (return))
 		    (let ((got (read-sequence buffer p :end
-					      (min left 1024))))
+					      (min left (length buffer)))))
 		      (if* (<= got 0) then (return))
 		      (write-sequence buffer *html-stream*
 				      :end got)