diff options
Diffstat (limited to 'spiffy.scm')
| -rw-r--r-- | spiffy.scm | 19 |
1 files changed, 12 insertions, 7 deletions
@@ -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)) |