Fix wrong transfer-encoding headers being sent

`Ocsigen_response` carries a `Cohttp.Response.t` and a `body` and both
of them carry a `transfer-encoding`.
The problem is that the `Cohttp.Response.t` is often constructed with a
default value for the transfer encoding that takes precedence over the
encoding of the body.

This changes `Ocsigen_response.make` to remove the header if it is equal
to the default value. The correct way to specify the encoding is while
constructing the `Body.t` value. Setting the header with
`Ocsigen_response.add_header` is also supported.

This bug could materialize with pages that never finish loading or with
trimmed content.
Especially in Eliom, where `Cohttp.Response.make` is often called
without the `~encoding` argument.

Author: Julow

src/server/ocsigen_response.ml

@@ -26,24 +26,26 @@ end
 type t =
   {a_response : Response.t; a_body : Body.t; a_cookies : Ocsigen_cookie_map.t}
 
+let remove_header_if_equal_to (resp : Response.t) header equals_to =
+  match Header.get resp.headers header with
+  | Some v when String.equal v equals_to ->
+      {resp with headers = Header.remove resp.headers header}
+  | _ -> resp
+
 let make ?(body = Body.empty) ?(cookies = Ocsigen_cookie_map.empty) a_response =
+  (* Remove the erroneous [transfer-encoding] set by default. *)
+  (* TODO: Deprecate usages of [Cohttp.Response.t] exposed by this API. *)
+  let a_response =
+    remove_header_if_equal_to a_response "transfer-encoding" "chunked"
+  in
   {a_response; a_body = body; a_cookies = cookies}
 
-let respond ?headers ~status ~encoding ?(body = Body.empty) () =
-  let encoding =
-    match headers with
-    | None -> encoding
-    | Some headers -> (
-      match Cohttp.Header.get_transfer_encoding headers with
-      | Cohttp.Transfer.Unknown -> encoding
-      | t -> t)
-  in
-  let response = Response.make ~status ~encoding ?headers () in
+let respond ?headers ~status ?(body = Body.empty) () =
+  let response = Response.make ~status ?headers () in
   make ~body response
 
 let respond_string ?headers ~status ~body () =
-  let encoding = Transfer.Fixed (Int64.of_int (String.length body)) in
-  let response = Response.make ~status ~encoding ?headers () in
+  let response = Response.make ~status ?headers () in
   let body = Body.of_string body in
   make ~body response
 
@@ -101,7 +103,7 @@ let respond_file ?headers ?(status = `OK) fname =
        let headers =
          Http.Header.add_opt_unless_exists headers "content-type" mime_type
        in
-       Lwt.return (respond ~headers ~status ~encoding ~body ()))
+       Lwt.return (respond ~headers ~status ~body ()))
     (function
       | Unix.Unix_error (Unix.ENOENT, _, _) | Isnt_a_file ->
           Lwt.return (respond_not_found ())
@@ -148,16 +150,14 @@ let make_cookies_headers path t hds =
          (make_cookies_header path exp name v secure))
     t hds
 
-let to_cohttp_response {a_response; a_cookies; a_body = _, encoding} =
+let to_cohttp_response {a_response; a_cookies; a_body = _, body_encoding} =
   let headers =
     let add name value headers = Header.add_unless_exists headers name value in
     let add_transfer_encoding h =
-      match encoding with
-      | Transfer.Chunked -> add "transfer-encoding" "chunked" h
-      | _ -> h
+      Header.add_transfer_encoding h body_encoding
     in
-    Ocsigen_cookie_map.Map_path.fold make_cookies_headers a_cookies
-      (Response.headers a_response)
+    Response.headers a_response
+    |> Ocsigen_cookie_map.Map_path.fold make_cookies_headers a_cookies
     |> add "server" Ocsigen_config.server_name
     |> add "date" (Ocsigen_lib.Date.to_string (Unix.time ()))
     |> add_transfer_encoding

src/server/ocsigen_response.mli

@@ -23,11 +23,15 @@ val make :
   -> ?cookies:Ocsigen_cookie_map.t
   -> Cohttp.Response.t
   -> t
+(** Make a response from a [Cohttp.Response.t]. Note that the
+    [transfer-encoding] header is not taken into account if it is set to
+    [chunked], use {!add_header}. This is because [Cohttp.Response.make] sets
+    this header by default, which interferes with the transfer-encoding carried
+    by the [body]. *)
 
 val respond :
    ?headers:Cohttp.Header.t
   -> status:Http.Status.t
-  -> encoding:Cohttp.Transfer.encoding
   -> ?body:Body.t
   -> unit
   -> t

test/extensions/deflatemod.t/run.t

@@ -14,13 +14,13 @@
   ocsigen:local-file: [INFO] Testing "./index.html".
   ocsigen:local-file: [INFO] checking if file index.html can be sent
   ocsigen:local-file: [INFO] Returning "./index.html".
-  ocsigen:access:  connection for local-test from unix:// (): /empty_dir/
+  ocsigen:access:  connection for local-test from unix: (): /empty_dir/
   ocsigen:ext: [INFO] host found! local-test:0 matches .* 
   ocsigen:ext:staticmod: [INFO] Is it a static file?
   ocsigen:local-file: [INFO] Testing "./empty_dir/".
   ocsigen:local-file: [INFO] Testing "./empty_dir/index.html" as possible index.
   ocsigen:local-file: [INFO] No index and no listing
-  ocsigen:access:  connection for local-test from unix:// (): /doesnt_exists.html
+  ocsigen:access:  connection for local-test from unix: (): /doesnt_exists.html
   ocsigen:ext: [INFO] host found! local-test:0 matches .* 
   ocsigen:ext:staticmod: [INFO] Is it a static file?
   ocsigen:local-file: [INFO] Testing "./doesnt_exists.html".
@@ -31,8 +31,8 @@ First response is not compressed:
   $ curl_ "index.html"
   HTTP/1.1 200 OK
   content-type: text/html
-  content-length: 12
   server: Ocsigen
+  content-length: 12
 
   Hello world
 
@@ -41,7 +41,6 @@ Second response is compressed:
   $ curl_ "index.html" --compressed
   HTTP/1.1 200 OK
   content-type: text/html
-  content-length: 12
   content-encoding: gzip
   server: Ocsigen
   transfer-encoding: chunked
@@ -53,13 +52,13 @@ compression:
 
   $ mkdir empty_dir && curl_ empty_dir/ --compressed
   HTTP/1.1 404 Not Found
-  content-length: 16
   server: Ocsigen
+  content-length: 16
 
   Error: Not Found
   $ curl_ doesnt_exists.html --compressed
   HTTP/1.1 404 Not Found
-  content-length: 16
   server: Ocsigen
+  content-length: 16
 
   Error: Not Found