From 2d82b5f2f07f5e730400857a7ef7e5cbb0dcf75a Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 27 Jul 2015 08:48:29 -0400
Subject: web-server: Bypass response sanitization for static files.

Just copy the raw bytes.

* haunt/serve/web-server.scm (dump-file): Delete.
  (render-file): Return a bytevector instead of a writer procedure.
---
 haunt/serve/web-server.scm | 13 ++-----------
 1 file changed, 2 insertions(+), 11 deletions(-)

diff --git a/haunt/serve/web-server.scm b/haunt/serve/web-server.scm
index 53ccc10..21cf193 100644
--- a/haunt/serve/web-server.scm
+++ b/haunt/serve/web-server.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 binary-ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (sxml simple)
@@ -90,21 +91,11 @@ Otherwise, return FILE-NAME as-is."
      ((file-exists? file-name) file-name)
      (else #f))))
 
-(define (dump-file file-name port)
-  "Write the contents of FILE-NAME to PORT."
-  (with-input-from-file file-name
-    (lambda ()
-      (let loop ((char (read-char)))
-        (unless (eof-object? char)
-          (write-char char port)
-          (loop (read-char)))))))
-
 (define (render-file file-name)
   "Return a 200 OK HTTP response that renders the contents of
 FILE-NAME."
   (values `((content-type . (,(mime-type file-name))))
-          (lambda (port)
-            (dump-file file-name port))))
+          (call-with-input-file file-name get-bytevector-all)))
 
 (define (render-directory path dir)
   "Render the contents of DIR represented by the URI PATH."
-- 
cgit v1.2.3