From a1b4680d5d4167972e078899a02b8a48b7b88c45 Mon Sep 17 00:00:00 2001
From: Eitaro Fukamachi <e.arrows@gmail.com>
Date: Mon, 12 Aug 2024 14:20:05 +0000
Subject: [PATCH] Load the pathname directly to the output buffer for reducing
 the memory usage.

---
 src/ev.lisp        |  2 ++
 src/ev/socket.lisp | 30 ++++++++++++++++++++++++++++++
 src/woo.lisp       |  6 +-----
 3 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/src/ev.lisp b/src/ev.lisp
index cf43072..bf7bcd6 100644
--- a/src/ev.lisp
+++ b/src/ev.lisp
@@ -16,6 +16,7 @@
                 :close-socket
                 :write-socket-data
                 :write-socket-byte
+                :write-socket-stream
                 :flush-buffer
                 :with-async-writing)
   (:import-from :woo.ev.event-loop
@@ -35,6 +36,7 @@
            :close-tcp-server
            :write-socket-data
            :write-socket-byte
+           :write-socket-stream
            :with-async-writing
            :socket-data
            :close-socket
diff --git a/src/ev/socket.lisp b/src/ev/socket.lisp
index 7504533..051d401 100644
--- a/src/ev/socket.lisp
+++ b/src/ev/socket.lisp
@@ -54,6 +54,7 @@
 
            :write-socket-data
            :write-socket-byte
+           :write-socket-stream
            :flush-buffer
            :with-async-writing
            :send-static-file
@@ -166,6 +167,35 @@
       (setf (socket-write-cb socket) write-cb))
     (fast-write-byte byte (socket-buffer socket))))
 
+(defun write-socket-stream (socket stream &key (write-cb nil write-cb-specified-p))
+  (declare (optimize speed)
+           (type file-stream stream))
+  (when (socket-open-p socket)
+    (when write-cb-specified-p
+      (setf (socket-write-cb socket) write-cb))
+    (let ((file-size (file-length stream))
+          (buffer (socket-buffer socket)))
+      ;; Fill the last vector of fast-io's buffer
+      (let* ((start (fast-io::output-buffer-fill buffer))
+             (end
+               (read-sequence (fast-io::output-buffer-vector buffer)
+                              stream
+                              :start start)))
+        (setf (fast-io::output-buffer-fill buffer) end)
+        (incf (fast-io::output-buffer-len buffer)
+              (- end start)))
+      (unless (= (file-position stream) file-size)
+        ;; Load the rest of file contents directly into the fast-io's buffer
+        (loop
+          (fast-io::extend buffer)
+          (let ((n
+                  (read-sequence (fast-io::output-buffer-vector buffer)
+                                 stream)))
+            (setf (fast-io::output-buffer-fill buffer) n)
+            (incf (fast-io::output-buffer-len buffer) n))
+          (when (= (file-position stream) file-size)
+            (return)))))))
+
 (declaim (inline reset-buffer))
 (defun reset-buffer (socket)
   (let ((buffer (socket-buffer socket)))
diff --git a/src/woo.lisp b/src/woo.lisp
index fcb561c..2c494dd 100644
--- a/src/woo.lisp
+++ b/src/woo.lisp
@@ -388,11 +388,7 @@
                                                                  (wev:close-socket socket))))
                   (write-response-headers socket status headers (not close))
                   ;; Future task: Use OpenSSL's SSL_sendfile which uses Kernel TLS.
-                  ;; TODO: Stop allocating an input buffer every time
-                  (loop with buffer = (make-array 4096 :element-type '(unsigned-byte 8))
-                        for n = (read-sequence buffer in)
-                        do (wev:write-socket-data socket buffer :end n)
-                        while (= n 4096))))))
+                  (wev:write-socket-stream socket in)))))
            (t
             (let* ((fd (wsys:open body))
                    (size #+lispworks (sys:file-size body)