summaryrefslogtreecommitdiff
path: root/module/web
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-28 22:26:44 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-28 22:41:25 +0100
commit75d6c59fc25cdcc02f19b626961d46a96bb33234 (patch)
tree4cae7bb7ee07cba3e974d69e771a170aadf9bf77 /module/web
parentee2d874119b898114c6f4b61051cc3c35e1bab38 (diff)
downloadguile-75d6c59fc25cdcc02f19b626961d46a96bb33234.tar.gz
web: Add `response-body-port'.
* module/web/response.scm (make-delimited-input-port, response-body-port): New procedures. (read-response-body): Use `response-body-port'. * test-suite/tests/web-response.test ("example-1")["response-body-port"]: New test. ("example-2")["response-body-port"]: New test.
Diffstat (limited to 'module/web')
-rw-r--r--module/web/response.scm70
1 files changed, 59 insertions, 11 deletions
diff --git a/module/web/response.scm b/module/web/response.scm
index 46345c0fd..5ca727409 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -23,6 +23,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (web http)
#:export (response?
@@ -37,6 +38,7 @@
write-response
response-must-not-include-body?
+ response-body-port
read-response-body
write-response-body
@@ -233,20 +235,66 @@ This is true for some response types, like those with code 304."
(= (response-code r) 204)
(= (response-code r) 304)))
+(define (make-delimited-input-port port len keep-alive?)
+ "Return an input port that reads from PORT, and makes sure that
+exactly LEN bytes are available from PORT. Closing the returned port
+closes PORT, unless KEEP-ALIVE? is true."
+ (define bytes-read 0)
+
+ (define (fail)
+ (bad-response "EOF while reading response body: ~a bytes of ~a"
+ bytes-read len))
+
+ (define (read! bv start count)
+ (let ((ret (get-bytevector-n! port bv start count)))
+ (if (eof-object? ret)
+ (if (= bytes-read len)
+ 0
+ (fail))
+ (begin
+ (set! bytes-read (+ bytes-read ret))
+ (if (> bytes-read len)
+ (fail)
+ ret)))))
+
+ (define close
+ (and (not keep-alive?)
+ (lambda ()
+ (close port))))
+
+ (make-custom-binary-input-port "delimited input port" read! #f #f close))
+
+(define* (response-body-port r #:key (decode? #t) (keep-alive? #t))
+ "Return an input port from which the body of R can be read. The
+encoding of the returned port is set according to R's ‘content-type’
+header, when it's textual, except if DECODE? is #f. Return #f when no
+body is available.
+
+When KEEP-ALIVE? is #f, closing the returned port also closes R's
+response port."
+ (define port
+ (if (member '(chunked) (response-transfer-encoding r))
+ (make-chunked-input-port (response-port r)
+ #:keep-alive? keep-alive?)
+ (let ((len (response-content-length r)))
+ (and len
+ (make-delimited-input-port (response-port r)
+ len keep-alive?)))))
+
+ (when (and decode? port)
+ (match (response-content-type r)
+ (((? text-content-type?) . props)
+ (set-port-encoding! port
+ (or (assq-ref props 'charset)
+ "ISO-8859-1")))
+ (_ #f)))
+
+ port)
+
(define (read-response-body r)
"Reads the response body from R, as a bytevector. Returns
‘#f’ if there was no response body."
- (if (member '(chunked) (response-transfer-encoding r))
- (let ((chunk-port (make-chunked-input-port (response-port r)
- #:keep-alive? #t)))
- (get-bytevector-all chunk-port))
- (let ((nbytes (response-content-length r)))
- (and nbytes
- (let ((bv (get-bytevector-n (response-port r) nbytes)))
- (if (= (bytevector-length bv) nbytes)
- bv
- (bad-response "EOF while reading response body: ~a bytes of ~a"
- (bytevector-length bv) nbytes)))))))
+ (and=> (response-body-port r #:decode? #f) get-bytevector-all))
(define (write-response-body r bv)
"Write BV, a bytevector, to the port corresponding to the HTTP