diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-11-28 22:26:44 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-11-28 22:41:25 +0100 |
commit | 75d6c59fc25cdcc02f19b626961d46a96bb33234 (patch) | |
tree | 4cae7bb7ee07cba3e974d69e771a170aadf9bf77 /module/web | |
parent | ee2d874119b898114c6f4b61051cc3c35e1bab38 (diff) | |
download | guile-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.scm | 70 |
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 |