Handle character encoding when a proc is used as the response body

In the web server. This means that characters not representable in ISO-8859-1 won't get transformed to a ?, if the charset is set to something that supports them, e.g. utf8.
wingo · Feb 8, 2025 · f58b933 · f58b933
1 parent 96cd1f4
commit f58b933
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 8 deletions.
diff --git a/fibers/web/server.scm b/fibers/web/server.scm
@@ -204,13 +204,24 @@ on the procedure being called at any particular time."
                   (write-response response client)
                   (when body
                     (if (procedure? body)
-                        (if (response-content-length response)
-                            (body client)
-                            (let ((chunked-port
-                                   (make-chunked-output-port client
-                                                             #:keep-alive? #t)))
-                              (body chunked-port)
-                              (close-port chunked-port)))
+                        (let* ((content-type
+                                (response-content-type response
+                                                       '(text/plain)))
+                               (declared-charset
+                                (assq-ref (cdr content-type) 'charset))
+                               (charset (or declared-charset "ISO-8859-1")))
+                          (if (response-content-length response)
+                              (begin
+                                ;; This will be reset in read-request
+                                ;; if the connection is kept alive
+                                (set-port-encoding! client charset)
+                                (body client))
+                              (let ((chunked-port
+                                     (make-chunked-output-port client
+                                                               #:keep-alive? #t)))
+                                (set-port-encoding! chunked-port charset)
+                                (body chunked-port)
+                                (close-port chunked-port))))
                         (put-bytevector client body)))
                   (force-output client)
                   (if (keep-alive? response)

diff --git a/tests/concurrent-web-server.scm b/tests/concurrent-web-server.scm
@@ -66,7 +66,19 @@
                 port
                 (uint-list->bytevector (iota 10000)
                                        (endianness little)
-                                       4)))))))
+                                       4)))))
+    ("/utf8-proc"
+     (values '((content-type . (text/plain
+                                (charset . "utf-8")))
+               (content-length . 3))
+             (lambda (port)
+               (display "☺" port))))
+    ("/utf8-proc-chunked"
+     (values '((content-type . (text/plain
+                                (charset . "utf-8"))))
+             (lambda (port)
+               (display "☺" port))))))
+
 
 (call-with-new-thread
  (lambda ()
@@ -98,4 +110,16 @@
       (assert-equal 10000
                     (length data)))))
 
+(call-with-values
+    (lambda ()
+      (http-get (string->uri "http://127.0.0.1:8080/utf8-proc")))
+  (lambda (response body)
+    (assert-equal "☺" body)))
+
+(call-with-values
+    (lambda ()
+      (http-get (string->uri "http://127.0.0.1:8080/utf8-proc-chunked")))
+  (lambda (response body)
+    (assert-equal "☺" body)))
+
 (exit (if failed? 1 0))