summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-01-11 11:10:24 +0100
committerAndy Wingo <wingo@pobox.com>2013-01-11 15:15:42 +0100
commit8cb9a30c17827bc875516b2abedee36a05f886e0 (patch)
tree94a8318d0b0a307e1b23bf386b9a65869bb54f50
parentf05bb8494c9636cd7a44aaf7d4e08f4b66004b6e (diff)
downloadguile-8cb9a30c17827bc875516b2abedee36a05f886e0.tar.gz
(web server) uses (ice-9 iconv)
* module/web/server.scm (sanitize-response): Use the procedures from (ice-9 iconv) to encode the response.
-rw-r--r--module/web/server.scm40
1 files changed, 3 insertions, 37 deletions
diff --git a/module/web/server.scm b/module/web/server.scm
index 23f344e56..54ab9e335 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -1,6 +1,6 @@
;;; Web server
-;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -80,6 +80,7 @@
#:use-module (web response)
#:use-module (system repl error-handling)
#:use-module (ice-9 control)
+ #:use-module (ice-9 iconv)
#:export (define-server-impl
lookup-server-impl
open-server
@@ -162,41 +163,6 @@ values."
#:on-error (if (batch-mode?) 'backtrace 'debug)
#:post-error (lambda _ (values #f #f #f))))
-;; like call-with-output-string, but actually closes the port (doh)
-(define (call-with-output-string* proc)
- (let ((port (open-output-string)))
- (proc port)
- (let ((str (get-output-string port)))
- (close-port port)
- str)))
-
-(define (call-with-output-bytevector* proc)
- (call-with-values
- (lambda ()
- (open-bytevector-output-port))
- (lambda (port get-bytevector)
- (proc port)
- (let ((bv (get-bytevector)))
- (close-port port)
- bv))))
-
-(define (call-with-encoded-output-string charset proc)
- (if (string-ci=? charset "utf-8")
- ;; I don't know why, but this appears to be faster; at least for
- ;; examples/debug-sxml.scm (1464 reqs/s versus 850 reqs/s).
- (string->utf8 (call-with-output-string* proc))
- (call-with-output-bytevector*
- (lambda (port)
- (set-port-encoding! port charset)
- (proc port)))))
-
-(define (encode-string str charset)
- (if (string-ci=? charset "utf-8")
- (string->utf8 str)
- (call-with-encoded-output-string charset
- (lambda (port)
- (display str port)))))
-
(define (extend-response r k v . additional)
(let ((r (build-response #:version (response-version r)
#:code (response-code r)
@@ -249,7 +215,7 @@ on the procedure being called at any particular time."
response
(extend-response response 'content-type
`(,@type (charset . ,charset))))
- (encode-string body charset))))
+ (string->bytevector body charset))))
((procedure? body)
(let* ((type (response-content-type response
'(text/plain)))