bug#13857: Unhandled case in module/web/response.scm

[Jason Earl]

On Sat, Mar 09 2013, Andy Wingo wrote:

> On Sat 09 Mar 2013 02:27, Daniel Hartwig <address@hidden> writes:
>
>> It is anyway clear that ‘response-body-port’ is missing the case where
>> a content-length header is not present and the body is terminated by
>> the server closing the port.  Some additional care needs to be taken,
>> e.g. ‘#:keep-alive?’ is incompatible with missing content-length.
>> Depending on how ‘response-body-port’ is used, I will have to consider
>> whether to signal an error or do something else in that case.
>>
>> Thanks for reporting this and hopefully it can be fixed for the next
>> point release.  As I am currently somewhat involved with the web
>> modules and related RFCs it is something else I can work on.
>
> Something like this?
>
> --- a/module/web/response.scm
> +++ b/module/web/response.scm
> @@ -273,13 +273,26 @@ 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?)))))
> +    (cond
> +     ((member '(chunked) (response-transfer-encoding r))
> +      (make-chunked-input-port (response-port r)
> +                               #:keep-alive? keep-alive?))
> +     ((response-content-length r)
> +      => (lambda (len)
> +           (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)))))
> +      port)
> +     (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.
> +      port)))
>  
>    (when (and decode? port)
>      (match (response-content-type r)
>
> Andy

That did not work for me.  My little test program crashes with the
following backtrace:

--8<---------------cut here---------------start------------->8---
Backtrace:
In ice-9/boot-9.scm:
 157: 7 [catch #t #<catch-closure a1175e0> ...]
In unknown file:
   ?: 6 [apply-smob/1 #<catch-closure a1175e0>]
In ice-9/boot-9.scm:
  63: 5 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 432: 4 [eval # #]
In /home/jearl/projects/scratch/testing.scm:
  12: 3 [main ("./testing.scm")]
In web/client.scm:
 230: 2 [request # # #f ...]
In web/response.scm:
 310: 1 [read-response-body #]
In unknown file:
   ?: 0 [get-bytevector-all #<unspecified>]
--8<---------------cut here---------------end--------------->8---

I hesitate to comment further, as I really do *not* know what I am
doing. However, is it possible that you mean something like this?

--8<---------------cut here---------------start------------->8---
diff --git a/module/web/response.scm b/module/web/response.scm
index 7e14f4d..3f97dff 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -273,13 +273,26 @@ 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?)))))
+    (cond
+     ((member '(chunked) (response-transfer-encoding r))
+      (make-chunked-input-port (response-port r)
+                               #:keep-alive? keep-alive?))
+     ((response-content-length r)
+      => (lambda (len)
+           (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)
     (match (response-content-type r)
--8<---------------cut here---------------end--------------->8---

That does work for me.

Thanks for taking the time to look at this.  I really feel like I am
learning a lot.

Jason Earl