"R. P. Dillon" <rpdil...@gmail.com> 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 <ianpric...@googlemail.com>
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
