diff --git a/fibers/web/server.scm b/fibers/web/server.scm index cfa9c087..5bd23b3c 100644 --- 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 index b6c4016d..0e5923f0 100644 --- 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))