(web response) and (web request): bodies are bytevectors

* module/web/request.scm (read-request-body, write-request-body): Rename
  from read-request-body/bytevector and
  write-request-body/bytevector.  Remove the /latin-1 variants, as they
  were unused and a bad idea.
* module/web/response.scm (read-response-body, write-response-body):
  Likewise.

* module/web/server/http.scm (http-read, http-write): Adapt to
  request/response change.

* test-suite/tests/web-request.test:
* test-suite/tests/web-response.test: Update tests.

diff --git a/module/web/request.scm b/module/web/request.scm
index 84bc36e..aa807d9 100644 (file)
--- a/module/web/request.scm
+++ b/module/web/request.scm
@@ -38,11 +38,8 @@
             build-request
             write-request
 
-            read-request-body/latin-1
-            write-request-body/latin-1
-
-            read-request-body/bytevector
-            write-request-body/bytevector
+            read-request-body
+            write-request-body
 
             ;; General headers
             ;;
@@ -198,44 +195,7 @@ on @var{port}, perhaps using some transfer encoding."
       (make-request (request-method r) (request-uri r) (request-version r)
                     (request-headers r) (request-meta r) port)))
 
-;; Probably not what you want to use "in production". Relies on one byte
-;; per char because we are in latin-1 encoding.
-;;
-(define (read-request-body/latin-1 r)
-  "Reads the request body from @var{r}, as a string.
-
-Assumes that the request port has ISO-8859-1 encoding, so that the
-number of characters to read is the same as the
-@code{request-content-length}. Returns @code{#f} if there was no request
-body."
-  (cond 
-   ((request-content-length r) =>
-    (lambda (nbytes)
-      (let ((buf (make-string nbytes))
-            (port (request-port r)))
-        (let lp ((i 0))
-          (cond
-           ((< i nbytes)
-            (let ((c (read-char port)))
-              (cond
-               ((eof-object? c)
-                (bad-request "EOF while reading request body: ~a bytes of ~a"
-                             i nbytes))
-               (else
-                (string-set! buf i c)
-                (lp (1+ i))))))
-           (else buf))))))
-   (else #f)))
-
-;; Likewise, assumes that body can be written in the latin-1 encoding,
-;; and that the latin-1 encoding is what is expected by the server.
-;;
-(define (write-request-body/latin-1 r body)
-  "Write @var{body}, a string encodable in ISO-8859-1, to the port
-corresponding to the HTTP request @var{r}."
-  (display body (request-port r)))
-
-(define (read-request-body/bytevector r)
+(define (read-request-body r)
   "Reads the request body from @var{r}, as a bytevector.  Returns
 @code{#f} if there was no request body."
   (let ((nbytes (request-content-length r)))
@@ -246,7 +206,7 @@ corresponding to the HTTP request @var{r}."
                (bad-request "EOF while reading request body: ~a bytes of ~a"
                             (bytevector-length bv) nbytes))))))
 
-(define (write-request-body/bytevector r bv)
+(define (write-request-body r bv)
   "Write @var{body}, a bytevector, to the port corresponding to the HTTP
 request @var{r}."
   (put-bytevector (request-port r) bv))

diff --git a/module/web/response.scm b/module/web/response.scm
index f8a87a2..c87f881 100644 (file)
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -37,11 +37,8 @@
             adapt-response-version
             write-response
 
-            read-response-body/latin-1
-            write-response-body/latin-1
-
-            read-response-body/bytevector
-            write-response-body/bytevector
+            read-response-body
+            write-response-body
 
             ;; General headers
             ;;
@@ -233,44 +230,7 @@ on @var{port}, perhaps using some transfer encoding."
       (make-response (response-version r) (response-code r)
                      (response-reason-phrase r) (response-headers r) port)))
 
-;; Probably not what you want to use "in production". Relies on one byte
-;; per char because we are in latin-1 encoding.
-;;
-(define (read-response-body/latin-1 r)
-  "Reads the response body from @var{r}, as a string.
-
-Assumes that the response port has ISO-8859-1 encoding, so that the
-number of characters to read is the same as the
-@code{response-content-length}. Returns @code{#f} if there was no
-response body."
-  (cond 
-   ((response-content-length r) =>
-    (lambda (nbytes)
-      (let ((buf (make-string nbytes))
-            (port (response-port r)))
-        (let lp ((i 0))
-          (cond
-           ((< i nbytes)
-            (let ((c (read-char port)))
-              (cond
-               ((eof-object? c)
-                (bad-response "EOF while reading response body: ~a bytes of ~a"
-                              i nbytes))
-               (else
-                (string-set! buf i c)
-                (lp (1+ i))))))
-           (else buf))))))
-   (else #f)))
-
-;; Likewise, assumes that body can be written in the latin-1 encoding,
-;; and that the latin-1 encoding is what is expected by the client.
-;;
-(define (write-response-body/latin-1 r body)
-  "Write @var{body}, a string encodable in ISO-8859-1, to the port
-corresponding to the HTTP response @var{r}."
-  (display body (response-port r)))
-
-(define (read-response-body/bytevector r)
+(define (read-response-body r)
   "Reads the response body from @var{r}, as a bytevector.  Returns
 @code{#f} if there was no response body."
   (let ((nbytes (response-content-length r)))
@@ -281,7 +241,7 @@ corresponding to the HTTP response @var{r}."
                (bad-response "EOF while reading response body: ~a bytes of ~a"
                             (bytevector-length bv) nbytes))))))
 
-(define (write-response-body/bytevector r bv)
+(define (write-response-body r bv)
   "Write @var{body}, a bytevector, to the port corresponding to the HTTP
 response @var{r}."
   (put-bytevector (response-port r) bv))

diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index e9d612b..a9a9049 100644 (file)
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -1,6 +1,6 @@
 ;;; Web I/O: HTTP
 
-;; Copyright (C)  2010 Free Software Foundation, Inc.
+;; Copyright (C)  2010, 2011 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
@@ -121,7 +121,7 @@
                  (let ((req (read-request port)))
                    (values port
                            req
-                           (read-request-body/bytevector req))))
+                           (read-request-body req))))
                (lambda (k . args)
                  (false-if-exception (close-port port)))))))))))))
 
@@ -142,12 +142,10 @@
          (port (response-port response)))
     (cond
      ((not body))                       ; pass
-     ((string? body)
-      (write-response-body/latin-1 response body))
      ((bytevector? body)
-      (write-response-body/bytevector response body))
+      (write-response-body response body))
      (else
-      (error "Expected a string or bytevector for body" body)))
+      (error "Expected a bytevector for body" body)))
     (cond
      ((keep-alive? response)
       (force-output port)

diff --git a/test-suite/tests/web-request.test b/test-suite/tests/web-request.test
index 32b99dd..e1eec2f 100644 (file)
--- a/test-suite/tests/web-request.test
+++ b/test-suite/tests/web-request.test
@@ -51,11 +51,8 @@ Accept-Language: en-gb, en;q=0.9\r
     
     (pass-if (equal? (request-uri r) (build-uri 'http #:path "/qux")))
     
-    (pass-if (equal? (read-request-body/latin-1 r) #f))
-    ;; Since it's #f, should be an idempotent read, so we can try
-    ;; bytevectors too
-    (pass-if (equal? (read-request-body/bytevector r) #f))
-    
+    (pass-if (equal? (read-request-body r) #f))
+
     (pass-if "checking all headers"
       (equal?
        (request-headers r)

diff --git a/test-suite/tests/web-response.test b/test-suite/tests/web-response.test
index 7e7331e..a21a702 100644 (file)
--- a/test-suite/tests/web-response.test
+++ b/test-suite/tests/web-response.test
@@ -20,6 +20,7 @@
 (define-module (test-suite web-response)
   #:use-module (web uri)
   #:use-module (web response)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-19)
   #:use-module (test-suite lib))
 
@@ -53,9 +54,9 @@ abcdefghijklmnopqrstuvwxyz0123456789")
         (set! r (read-response (open-input-string example-1)))
         (response? r)))
     
-    (pass-if "read-response-body/latin-1"
+    (pass-if "read-response-body"
       (begin
-        (set! body (read-response-body/latin-1 r))
+        (set! body (read-response-body r))
         #t))
     
     (pass-if (equal? (response-version r) '(1 . 1)))
@@ -64,7 +65,9 @@ abcdefghijklmnopqrstuvwxyz0123456789")
     
     (pass-if (equal? (response-reason-phrase r) "OK"))
     
-    (pass-if (equal? body "abcdefghijklmnopqrstuvwxyz0123456789"))
+    (pass-if (equal? body 
+                     (string->utf8
+                      "abcdefghijklmnopqrstuvwxyz0123456789")))
     
     (pass-if "checking all headers"
       (equal?
@@ -88,10 +91,10 @@ abcdefghijklmnopqrstuvwxyz0123456789")
                 (with-output-to-string
                   (lambda ()
                     (let ((r (write-response r (current-output-port))))
-                      (write-response-body/latin-1 r body))))
+                      (write-response-body r body))))
               (lambda ()
                 (let ((r (read-response (current-input-port))))
-                  (values r (read-response-body/latin-1 r))))))
+                  (values r (read-response-body r))))))
         (lambda (r* body*)
           (responses-equal? r body r* body*))))