From b040aa951f2b79e8d050f3fe214379c98bca0fa3 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 20 Jun 2025 15:55:35 +0200 Subject: [PATCH] Upgrade to Cohttp 6.0.0 This upgrade is needed to be able to target `cohttp-eio` which was added in version 6.0.0. Cohttp doesn't carry the content encoding in the Response type so some code is added to add the `transfer-encoding` header. --- dune-project | 4 ++-- ocsigenserver.opam | 4 ++-- src/extensions/deflatemod.ml | 11 +++++------ src/server/ocsigen_cohttp.ml | 12 +++++------- src/server/ocsigen_response.ml | 18 +++++++++++++----- test/extensions/deflatemod.t/run.t | 7 ++++--- 6 files changed, 31 insertions(+), 25 deletions(-) diff --git a/dune-project b/dune-project index 9e0b44e7f..0496f7267 100644 --- a/dune-project +++ b/dune-project @@ -18,8 +18,8 @@ (depends (ocaml (>= 4.08.1)) (camlzip (>= 1.04)) - (cohttp-lwt-unix (and (>= 5.0) (< 6.0))) - (conduit-lwt-unix (and (>= 2.0) (< 7.0))) + (cohttp-lwt-unix (>= 6.0)) + conduit-lwt-unix http cryptokit (ipaddr (>= 2.1)) diff --git a/ocsigenserver.opam b/ocsigenserver.opam index ef989a6dd..130baa5a2 100644 --- a/ocsigenserver.opam +++ b/ocsigenserver.opam @@ -13,8 +13,8 @@ depends: [ "dune" {>= "3.19"} "ocaml" {>= "4.08.1"} "camlzip" {>= "1.04"} - "cohttp-lwt-unix" {>= "5.0" & < "6.0"} - "conduit-lwt-unix" {>= "2.0" & < "7.0"} + "cohttp-lwt-unix" {>= "6.0"} + "conduit-lwt-unix" "http" "cryptokit" "ipaddr" {>= "2.1"} diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index 2ca4adfe5..380cd4d78 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -205,8 +205,9 @@ let stream_filter contentencoding url deflate choice res = | None, _ | _, None -> Lwt.return res | Some a, Some b when should_compress (a, b) url choice -> let response = - let response = Ocsigen_response.response res in - let headers = Cohttp.Response.headers response in + let {Http.Response.headers; status; version} = + Ocsigen_response.response res + in let headers = let name = Ocsigen_header.Name.(to_string etag) in match Cohttp.Header.get headers name with @@ -217,13 +218,11 @@ let stream_filter contentencoding url deflate choice res = | None -> headers in let headers = - Cohttp.Header.replace headers + Http.Header.replace headers Ocsigen_header.Name.(to_string content_encoding) contentencoding in - { response with - Cohttp.Response.headers - ; Cohttp.Response.encoding = Cohttp.Transfer.Chunked } + Http.Response.make ~headers ~status ~version () and body = Ocsigen_response.Body.make Cohttp.Transfer.Chunked (compress_body deflate diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index fcef7343e..02cb142e3 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -57,11 +57,11 @@ end let handler ~ssl ~address ~port ~connector (flow, conn) request body = let filenames = ref [] in let edn = Conduit_lwt_unix.endp_of_flow flow in - let rec getsockname = function - | `TCP (ip, _port) -> Ipaddr.to_string ip - | `Unix_domain_socket path -> "unix://" ^ path - | `TLS (_, edn) -> getsockname edn - | `Unknown _ | `Vchan_direct _ | `Vchan_domain_socket _ -> "unknown" + let getsockname = function + | `TCP (ip, _) | `TLS (_, `TCP (ip, _)) -> Ipaddr.to_string ip + | `Unix_domain_socket path | `TLS (_, `Unix_domain_socket path) -> + "unix://" ^ path + | _ -> "unknown" in let sockaddr = getsockname edn in let connection_closed = @@ -155,8 +155,6 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = let conn_closed (_flow, conn) = try - Logs.debug ~src:section (fun fmt -> - fmt "Connection closed:\n%s" (Cohttp.Connection.to_string conn)); Lwt.wakeup (snd (Hashtbl.find connections conn)) (); Hashtbl.remove connections conn; decr_connected () diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml index d9e5fe7d2..7bfdb8449 100644 --- a/src/server/ocsigen_response.ml +++ b/src/server/ocsigen_response.ml @@ -53,7 +53,8 @@ let respond_error ?headers ?(status = `Internal_server_error) ~body () = let update ?response ?body ?cookies {a_response; a_body; a_cookies} = let a_response = match response with Some response -> response | None -> a_response - and a_body = match body with Some body -> body | None -> a_body + in + let a_body = match body with Some body -> body | None -> a_body and a_cookies = match cookies with Some cookies -> cookies | None -> a_cookies in @@ -90,19 +91,25 @@ 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 = _} = +let to_cohttp_response {a_response; a_cookies; a_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 + in Ocsigen_cookie_map.Map_path.fold make_cookies_headers a_cookies (Response.headers a_response) |> add "server" Ocsigen_config.server_name |> add "date" (Ocsigen_lib.Date.to_string (Unix.time ())) + |> add_transfer_encoding in {a_response with Response.headers} let to_response_expert t = let module R = Cohttp_lwt_unix.Response in - let write_footer {R.encoding; _} oc = + let write_footer encoding oc = (* Copied from [cohttp/response.ml]. *) match encoding with | Transfer.Chunked -> Lwt_io.write oc "0\r\n\r\n" @@ -112,8 +119,9 @@ let to_response_expert t = ( res , fun _ic oc -> let writer = R.make_body_writer ~flush:false res oc in - let* () = fst t.a_body (R.write_body writer) in - write_footer res oc ) + let body, encoding = t.a_body in + let* () = body (R.write_body writer) in + write_footer encoding oc ) let response t = t.a_response let body t = t.a_body diff --git a/test/extensions/deflatemod.t/run.t b/test/extensions/deflatemod.t/run.t index 663578ec8..c7323acd7 100644 --- a/test/extensions/deflatemod.t/run.t +++ b/test/extensions/deflatemod.t/run.t @@ -1,14 +1,14 @@ $ source ../../server-test-helpers.sh $ run_server ./test.exe ocsigen:main: [WARNING] Command pipe created - ocsigen:access: connection for local-test from (): /index.html + ocsigen:access: connection for local-test from unix:// (): /index.html ocsigen:ext: [INFO] host found! local-test:0 matches .* ocsigen:ext:staticmod: [INFO] Is it a static file? ocsigen:local-file: [INFO] Testing "./index.html". ocsigen:local-file: [INFO] checking if file index.html can be sent ocsigen:ext: [INFO] Compiling exclusion regexp $^ ocsigen:local-file: [INFO] Returning "./index.html". - ocsigen:access: connection for local-test from (): /index.html + ocsigen:access: connection for local-test from unix:// (): /index.html ocsigen:ext: [INFO] host found! local-test:0 matches .* ocsigen:ext:staticmod: [INFO] Is it a static file? ocsigen:local-file: [INFO] Testing "./index.html". @@ -21,8 +21,8 @@ First response is not compressed: $ curl_ "index.html" HTTP/1.1 200 OK content-type: text/html - server: Ocsigen content-length: 12 + server: Ocsigen Hello world @@ -31,6 +31,7 @@ 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