mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-22 04:30:19 +02:00
fix response-body-port for responses without content-length
* module/web/response.scm (response-body-port): Correctly handle cases in which EOF terminates the body.
This commit is contained in:
parent
94c53e0601
commit
84dfde82ae
1 changed files with 20 additions and 7 deletions
|
@ -273,13 +273,26 @@ body is available.
|
||||||
When KEEP-ALIVE? is #f, closing the returned port also closes R's
|
When KEEP-ALIVE? is #f, closing the returned port also closes R's
|
||||||
response port."
|
response port."
|
||||||
(define port
|
(define port
|
||||||
(if (member '(chunked) (response-transfer-encoding r))
|
(cond
|
||||||
(make-chunked-input-port (response-port r)
|
((member '(chunked) (response-transfer-encoding r))
|
||||||
#:keep-alive? keep-alive?)
|
(make-chunked-input-port (response-port r)
|
||||||
(let ((len (response-content-length r)))
|
#:keep-alive? keep-alive?))
|
||||||
(and len
|
((response-content-length r)
|
||||||
(make-delimited-input-port (response-port r)
|
=> (lambda (len)
|
||||||
len keep-alive?)))))
|
(make-delimited-input-port (response-port r)
|
||||||
|
len keep-alive?)))
|
||||||
|
((response-must-not-include-body? r)
|
||||||
|
#f)
|
||||||
|
((or (memq 'close (response-connection r))
|
||||||
|
(and (equal? (response-version r) '(1 . 0))
|
||||||
|
(not (memq 'keep-alive (response-connection r)))))
|
||||||
|
(response-port r))
|
||||||
|
(else
|
||||||
|
;; Here we have a message with no transfer encoding, no
|
||||||
|
;; content-length, and a response that won't necessarily be closed
|
||||||
|
;; by the server. Not much we can do; assume that the client
|
||||||
|
;; knows how to handle it.
|
||||||
|
(response-port r))))
|
||||||
|
|
||||||
(when (and decode? port)
|
(when (and decode? port)
|
||||||
(match (response-content-type r)
|
(match (response-content-type r)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue