I attached the patch here.
The patch works for me. And I've tested it compared to the old way, say,
read the content to memory then pass it as the body then send to the
client.
Please test this feature with bigger file (larger than 20MB), the small
file is hard to show the difference.
On average, the old way is 5 times slower than new way (10s vs. 50s).
The test code is:
---------------------------code------------------------------
(define (send-the-file r fn)
(define in (open-input-file fn))
(define size (stat:size (stat fn)))
(define res (build-response #:headers `((content-length . ,size))))
(values res (lambda () (sendfile (request-port r) in size)
(close in))))
(run-server
(lambda (r b)
(send-the-file r "/var/www/mediawiki-1.21.3.tar.gz"))
'http)
----------------------------end------------------------------
It's the users duty to pass all the related headers in this way.
The patch was attached.
>From ceac1650327396199dc5114a898233584e4d5d3a Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalagin...@gmail.com>
Date: Tue, 26 Aug 2014 13:18:51 +0800
Subject: [PATCH] The built-in http server supports thunk as body to take
advantage of sendfile
---
module/web/server.scm | 6 ++++++
module/web/server/http.scm | 1 +
2 files changed, 7 insertions(+)
diff --git a/module/web/server.scm b/module/web/server.scm
index 471bb98..b358fec 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -216,6 +216,12 @@ on the procedure being called at any particular time."
(extend-response response 'content-type
`(,@type (charset . ,charset))))
(string->bytevector body charset))))
+ ((thunk? body)
+ (values
+ response
+ (if (eq? (request-method request) 'HEAD)
+ #f
+ body)))
((procedure? body)
(let* ((type (response-content-type response
'(text/plain)))
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index cda44f4..3767c61 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -154,6 +154,7 @@
(port (response-port response)))
(cond
((not body)) ; pass
+ ((thunk? body) (body))
((bytevector? body)
(write-response-body response body))
(else
--
1.7.10.4
