Eliminate "output-octets" instance.
authorChris Hanson <org/chris-hanson/cph>
Wed, 26 Apr 2017 05:51:31 +0000 (22:51 -0700)
committerChris Hanson <org/chris-hanson/cph>
Wed, 26 Apr 2017 05:51:31 +0000 (22:51 -0700)
src/ssp/mod-lisp.scm

index c3d3491240f2e9d9378612dc05b47bc8aea1f978..a7db288cc1686e86ef9bb018b1abb1346a230688 100644 (file)
@@ -384,26 +384,35 @@ USA.
   (set-status-header response code)
   (set-content-type-header response 'text/html)
   (set-entity response
-             (call-with-output-octets
-              (lambda (port)
-                (write-xml
-                 (let ((message (status-message code)))
-                   (html:html #f
-                              "\n"
-                              (html:head #f
-                                         "\n"
-                                         (html:title #f code " " message)
-                                         "\n")
-                              "\n"
-                              (html:body #f
-                                         "\n"
-                                         (html:h1 #f message)
-                                         "\n"
-                                         extra
-                                         "\n")
-                              "\n"))
-                 port)
-                (newline port)))))
+             (bytevector->string
+              (call-with-output-bytevector
+               (lambda (port)
+                 (write-xml
+                  (let ((message (status-message code)))
+                    (html:html #f
+                               "\n"
+                               (html:head #f
+                                          "\n"
+                                          (html:title #f code " " message)
+                                          "\n")
+                               "\n"
+                               (html:body #f
+                                          "\n"
+                                          (html:h1 #f message)
+                                          "\n"
+                                          extra
+                                          "\n")
+                               "\n"))
+                  port)
+                 (newline port))))))
+
+(define (bytevector->string bv)
+  (let* ((n (bytevector-length bv))
+        (builder (string-builder)))
+    (do ((i 0 (fix:+ i 1)))
+       ((not (fix:< i n)))
+      (builder (integer->char (bytevector-u8-ref bv i))))
+    (builder)))
 
 (define (set-status-header message code)
   (set-header message