Adding test case and fixing un-terminated requests

collects/meta/props

@@ -1951,6 +1951,7 @@ path/s is either such a string or a list of them.
 "collects/tests/unstable/srcloc.rktl" responsible (cce) drdr:command-line (racket "-f" *)
 "collects/tests/utils/gui.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/tests/web-server" responsible (jay)
+"collects/tests/web-server/pr/length.rkt" drdr:command-line #f
 "collects/tests/web-server/run-all-tests.rkt" drdr:timeout 300
 "collects/tests/web-server/servlet-env/env.rkt" drdr:command-line (mzc *)
 "collects/tests/web-server/servlet-env/insta.rkt" drdr:command-line (mzc "-k" *)

collects/tests/web-server/pr/length.rkt

@@ -0,0 +1,6 @@
+#lang web-server/insta
+
+(define (start req)
+  (response 200 #"Okay" (current-seconds)
+            #"text/html" empty
+            (λ (op) (write-bytes #"PONG" op))))

collects/web-server/http/response.rkt

@@ -18,48 +18,12 @@
  [rename ext:output-response/method output-response/method (connection? response? bytes? . -> . void)]
  [rename ext:output-file output-file (connection? path-string? bytes? bytes? (or/c pair? false/c) . -> . void)])
 
-;; Table 1. head responses:
-; ------------------------------------------------------------------------------
-; |method | close? | x-fer coding || response actions
-; |-----------------------------------------------------------------------------
-; |-----------------------------------------------------------------------------
-; |head   |   #t   | chunked      || 1. Output the headers only.
-; |-------------------------------|| 2. Add the special connection-close header.
-; |head   |   #t   | not-chunked  ||
-; |-----------------------------------------------------------------------------
-; |head   |   #f   | chunked      || 1. Output the headers only.
-; |-------------------------------|| 2. Don't add the connection-close header.
-; |head   |   #f   | not-chunked  ||
-; |-----------------------------------------------------------------------------
-
-;; Table 2. get responses:
-; ------------------------------------------------------------------------------
-; |method | x-fer-coding | close? || response actions
-; |-----------------------------------------------------------------------------
-; |-----------------------------------------------------------------------------
-; | get   | chunked      |   #t   || 1. Output headers as above.
-; |       |              |        || 2. Generate trivial chunked response.
-; |-----------------------------------------------------------------------------
-; | get   | chunked      |   #f   || 1. Output headers as above.
-; |       |              |        || 2. Generate chunks as per RFC 2616 sec. 3.6
-; |-----------------------------------------------------------------------------
-; | get   | not chunked  |   #t   || 1. Output headers as above.
-; |-------------------------------|| 2. Generate usual non-chunked response.
-; | get   | not chunked  |   #f   ||
-; |-----------------------------------------------------------------------------
-
-;; Notes:
-;; 1. close? is a boolean which corresponds roughly to the protocol version.
-;;    #t |-> 1.0 and #f |-> 1.1. See function close-connection?
-;;
-;; 2. In the case of a chunked response when close? = #f, then the response
-;;    must be compliant with http 1.0. In this case the chunked response is
-;;    simply turned into a non-chunked one.
-
 (define (output-response conn resp)
   (output-response/method conn resp #"GET"))
 
 (define (output-response/method conn resp meth)
+  (unless (terminated-response? resp)
+    (set-connection-close?! conn #t))
   (output-response-head conn resp)
   (unless (bytes-ci=? meth #"HEAD")
     (output-response-body conn resp)))
@@ -95,6 +59,15 @@
             headers)
   (fprintf out "\r\n"))
 
+; RFC 2616 Section 4.4
+(define (terminated-response? r)
+  (define hs (response-headers r))
+  (or (headers-assq* #"Content-Length" hs)
+      (cond 
+        [(headers-assq* #"Transfer-Encoding" hs)
+         => (λ (h) (not (bytes=? (header-value h) #"identity")))]
+        [else #f])))
+
 (define (output-response-body conn bresp)
   (define o-port (connection-o-port conn))
   ((response-output bresp) o-port)