From c38f745b32260497909c4073ad9f334ac3e77daa Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 18 Jul 2025 14:21:04 +0200 Subject: [PATCH] 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. --- src/server/ocsigen_response.ml | 38 +++++++++++++++--------------- src/server/ocsigen_response.mli | 6 ++++- test/extensions/deflatemod.t/run.t | 11 ++++----- 3 files changed, 29 insertions(+), 26 deletions(-) diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml index f23f863a2..649daec92 100644 --- a/src/server/ocsigen_response.ml +++ b/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 diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli index 12998f448..24280d8d4 100644 --- a/src/server/ocsigen_response.mli +++ b/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 diff --git a/test/extensions/deflatemod.t/run.t b/test/extensions/deflatemod.t/run.t index 436190c07..fa83d04b7 100644 --- a/test/extensions/deflatemod.t/run.t +++ b/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