Re: HTTP Request/Response questions

[Ian Price]

"R. P. Dillon" <address@hidden> writes:

> (http-get (string->uri "http://www.cnn.com";))
>
> yields:
>
> web/client.scm:109:4: In procedure http-get:
> web/client.scm:109:4: Throw to key `bad-response' with args `("EOF while
> reading response body: ~a bytes of ~a" (18576 106274))'.
>
> In web/client.scm:
>     109:4  0 (http-get #<<uri> scheme: http userinfo: #f host: "www.cnn.com"
> port: #f path: "" query: #f fragment: #f> #:port #<input-o…> …)
I see, http-get by default sends a "Connection: close" header, which is
probably responsible for this behaviour. Using the keep-alive keyword
argument should rectify this.

  (http-get (string->uri "http://www.cnn.com";) #:keep-alive? #t)

> In your google.com web client example, the request seemed to return the body
> of the document, but I'm still encountering the -1 expiration problem. (Guile
> 2.0.3, though I think I'll go back to the git repo if I can work around a
> recent compilation error that showed up).
If you aren't needing the date header, then I'd suggest doing the same
for the date header as I did for the etag header. It's a band-aid, but
I'm not really sure why you'd be getting a -1 date.

> Thanks for your help with this.
No problem.

I've also attached a patch for _reading_ chunk-encoded data. It will
also modify http-get to handle that for you.


Other Guilers,

If you use the web modules, _please_ comment on my suggestions for
chunked encoding support. See
http://article.gmane.org/gmane.lisp.guile.devel/12814 for details.

-- 
Ian Price

"Programming is like pinball. The reward for doing it well is
the opportunity to do it again" - from "The Wizardy Compiled"

>From f58482fcae11690b23924334f7b89ba136a7fddc Mon Sep 17 00:00:00 2001
From: Ian Price <address@hidden>
Date: Sun, 6 Nov 2011 20:42:25 +0000
Subject: [PATCH] Add support for transfer-encoded responses

---
 module/web/client.scm              |    4 ++-
 module/web/response.scm            |   46 ++++++++++++++++++++++++++++++++++++
 test-suite/tests/web-response.test |   25 +++++++++++++++++++
 3 files changed, 74 insertions(+), 1 deletions(-)

diff --git a/module/web/client.scm b/module/web/client.scm
index 6a04497..78d5201 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -107,7 +107,9 @@
     (if (not keep-alive?)
         (shutdown port 1))
     (let* ((res (read-response port))
-           (body (read-response-body res)))
+           (body (if (member '(chunked) (response-transfer-encoding res))
+                     (read-chunked-response-body res)
+                     (read-response-body res))))
       (if (not keep-alive?)
           (close-port port))
       (values res
diff --git a/module/web/response.scm b/module/web/response.scm
index 6283772..e24ac0b 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -20,6 +20,8 @@
 ;;; Code:
 
 (define-module (web response)
+  #:use-module (srfi srfi-1)
+  #:use-module (rnrs control)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 rdelim)
@@ -39,6 +41,7 @@
             read-response-body
             write-response-body
 
+            read-chunked-response-body
             ;; General headers
             ;;
             response-cache-control
@@ -230,6 +233,49 @@ on @var{port}, perhaps using some transfer encoding."
 response @var{r}."
   (put-bytevector (response-port r) bv))
 
+
+(define (read-chunk-header port)
+  (let* ((str (read-line port))
+         (extension-start (string-index str (lambda (c) (or (char=? c #\;)
+                                                       (char=? c #\return)))))
+         (size (string->number (if extension-start ; unnecessary?
+                                   (substring str 0 extension-start)
+                                   str)
+                               16)))
+    size))
+
+(define (read-chunk port)
+  (let ((size (read-chunk-header port)))
+    (read-chunk-body port size)))
+
+(define (read-chunk-body port size)
+  (let ((bv (get-bytevector-n port size)))
+    (get-u8 port)                       ; CR
+    (get-u8 port)                       ; LF
+    bv))
+
+(define (read-chunked-response-body r)
+  (let ((port (response-port r)))
+    (let loop ((chunks '()))
+      (let ((chunk (read-chunk port)))
+        (if (zero? (bytevector-length chunk))
+            (bytevector-concatenate (reverse! chunks))
+            (loop (cons chunk chunks)))))))
+
+(define (bytevector-concatenate bvs)
+  (let* ((total-length (fold (lambda (bv total)
+                               (+ (bytevector-length bv) total))
+                             0
+                             bvs))
+         (result (make-bytevector total-length)))
+    (let loop ((start 0) (bvs bvs))
+      (unless (null? bvs)
+        (let ((len (bytevector-length (car bvs))))
+          (bytevector-copy! (car bvs) 0 result start len)
+          (loop (+ start len) (cdr bvs)))))
+    result))
+
+
 (define-syntax define-response-accessor
   (lambda (x)
     (syntax-case x ()
diff --git a/test-suite/tests/web-response.test 
b/test-suite/tests/web-response.test
index a21a702..bc55704 100644
--- a/test-suite/tests/web-response.test
+++ b/test-suite/tests/web-response.test
@@ -40,6 +40,19 @@ Content-Type: text/html; charset=utf-8\r
 \r
 abcdefghijklmnopqrstuvwxyz0123456789")
 
+(define example-2
+  "HTTP/1.1 200 OK\r
+Transfer-Encoding: chunked\r
+Content-Type: text/plain\r
+\r
+1c\r
+Lorem ipsum dolor sit amet, \r
+1d\r
+consectetur adipisicing elit,\r
+43\r
+ sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.\r
+0\r\n")
+
 (define (responses-equal? r1 body1 r2 body2)
   (and (equal? (response-version r1) (response-version r2))
        (equal? (response-code r1) (response-code r2))
@@ -100,3 +113,15 @@ abcdefghijklmnopqrstuvwxyz0123456789")
 
     (pass-if "by accessor"
       (equal? (response-content-encoding r) '(gzip)))))
+
+
+(with-test-prefix "example-2"
+  (let* ((r (read-response (open-input-string example-2)))
+         (b (read-chunked-response-body r)))
+    (pass-if (equal? '((chunked))
+                     (response-transfer-encoding r)))
+    (pass-if (equal? b
+                     (string->utf8
+                      (string-append
+                       "Lorem ipsum dolor sit amet, consectetur adipisicing 
elit,"
+                       " sed do eiusmod tempor incididunt ut labore et dolore 
magna aliqua."))))))
-- 
1.7.6.4