Fix content-length to use byte count instead of char count on C66.5

Also, default to utf-8 charsets in default mime type map and default
response headers and when sending status responses and in the simple
directory handler.

1 files changed, 12 insertions, 7 deletions

diff --git a/spiffy.scm b/spiffy.scm
index 8768d5f..54fb8c9 100644
--- a/spiffy.scm
+++ b/spiffy.scm
@@ -58,9 +58,14 @@
         uri-common sendfile (rename intarweb (headers intarweb:headers)))
 
 (cond-expand
-  (chicken-6 (import (scheme base))) ; For make-parameter, which moved from (chicken base)
+  (chicken-6 (import (scheme base) (chicken memory representation))) ; For make-parameter, which moved from (chicken base)
   (else))
 
+(define (string-byte-length s)
+  (cond-expand
+    (chicken-6 (number-of-bytes s))
+    (else (string-length s))))
+
 (define version 6)
 (define release 4)
 
@@ -88,10 +93,10 @@
 ;; with links to RFCs describing the gory details.
 (define mime-type-map
   (make-parameter
-   '(("html" . text/html)
+   '(("html" . #(text/html ((charset . utf-8))))
      ("xhtml" . application/xhtml+xml)
      ("js"  . application/javascript)
-     ("css" . text/css)
+     ("css" . #(text/css ((charset . utf-8))))
      ("png" . image/png)
      ;; A charset parameter is STRONGLY RECOMMENDED by RFC 3023 but it overrides
      ;; document declarations, so don't supply it (assume nothing about files)
@@ -104,7 +109,7 @@
      ("gif" . image/gif)
      ("ico" . image/vnd.microsoft.icon)
      ("svg" . image/svg+xml)
-     ("txt" . text/plain))))
+     ("txt" . #(text/plain ((charset . utf-8)))))))
 (define default-mime-type (make-parameter 'application/octet-stream))
 (define file-extension-handlers (make-parameter '()))
 (define default-host    (make-parameter "localhost")) ;; XXX Can we do without?
@@ -290,7 +295,7 @@
               "  </body>\n"
               "</html>\n")))
     (send-response code: code reason: reason
-                   body: output headers: '((content-type text/html)))))
+                   body: output headers: '((content-type #(text/html ((charset . utf-8))))))))
 
 (define (call-with-input-file* file proc)
   (call-with-input-file file (lambda (p)
@@ -300,7 +305,7 @@
                         #:binary))
 
 (define (send-response #!key code reason status body (headers '()))
-  (let* ((new-headers (cons `(content-length ,(if body (string-length body) 0))
+  (let* ((new-headers (cons `(content-length ,(if body (string-byte-length body) 0))
                             headers))
          (h (intarweb:headers new-headers (response-headers (current-response))))
          (resp (if (and status (not code) (not reason))
@@ -505,7 +510,7 @@
                            (make-response
                             port: out
                             headers: (intarweb:headers
-                                      `((content-type text/html)
+                                      `((content-type #(text/html ((charset . utf-8))))
                                         (server ,(server-software))))))
                           (request-restarter cont))
              (debug! "Handling request from ~A" (remote-address))