From 9401b62ee56a63116122fe14a3b25baed827556e Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 12 May 2025 17:47:58 +0200
Subject: [PATCH 01/12] Ocsigen_response: Eio-compatible Body

This changes the representation of the body of the response to be
compatible with Cohttp-eio.

This now uses 'Cohttp_lwt_unix.Server.make_expert', which expect a
representation for the body that is closer to direct-style instead of
using the same Body type as for requests.

The setting of cookie headers is moved into 'Ocsigen_response', with the
goal of building a safer API.
---
 src/server/dune                 |  1 +
 src/server/ocsigen_cohttp.ml    | 54 +++-------------------
 src/server/ocsigen_response.ml  | 81 +++++++++++++++++++++++++++++----
 src/server/ocsigen_response.mli | 38 ++++++++++++++--
 4 files changed, 116 insertions(+), 58 deletions(-)

diff --git a/src/server/dune b/src/server/dune
index 507ac2429..0f316372c 100644
--- a/src/server/dune
+++ b/src/server/dune
@@ -5,6 +5,7 @@
  (libraries
   xml-light
   cohttp-lwt-unix
+  http
   polytables
   ocsigen_cookie_map
   baselib
diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml
index 7859f7f9b..c2405e149 100644
--- a/src/server/ocsigen_cohttp.ml
+++ b/src/server/ocsigen_cohttp.ml
@@ -54,32 +54,6 @@ module Cookie = struct
     Ocsigen_cookie_map.Map_path.fold serialize_cookies cookies headers
 end
 
-(* FIXME: secure *)
-let make_cookies_header path exp name c _secure =
-  Format.sprintf "%s=%s%s%s" name c
-    (*VVV encode = true? *)
-    ("; path=/" ^ Ocsigen_lib.Url.string_of_url_path ~encode:true path)
-    (* (if secure && slot.sl_ssl then "; secure" else "")^ *)
-    ""
-  ^
-  match exp with
-  | Some s -> "; expires=" ^ Ocsigen_lib.Date.to_string s
-  | None -> ""
-
-let make_cookies_headers path t hds =
-  Ocsigen_cookie_map.Map_inner.fold
-    (fun name c h ->
-       let open Ocsigen_cookie_map in
-       let exp, v, secure =
-         match c with
-         | OUnset -> Some 0., "", false
-         | OSet (t, v, secure) -> t, v, secure
-       in
-       Cohttp.Header.add h
-         Ocsigen_header.Name.(to_string set_cookie)
-         (make_cookies_header path exp name v secure))
-    t hds
-
 let handler ~ssl ~address ~port ~connector (flow, conn) request body =
   let filenames = ref [] in
   let edn = Conduit_lwt_unix.endp_of_flow flow in
@@ -133,6 +107,7 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
     Cohttp_lwt_unix.Server.respond_error ?headers
       ~status:(ret_code :> Cohttp.Code.status_code)
       ~body ()
+    >>= fun resp -> Lwt.return (Ocsigen_response.of_cohttp resp)
   in
   (* TODO: equivalent of Ocsigen_range *)
   let request =
@@ -155,32 +130,17 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
                   Ocsigen_header.Name.x_forwarded_for))
             (Uri.path (Ocsigen_request.uri request)));
        Lwt.catch
-         (fun () ->
-            connector request >>= fun response ->
-            let response, body = Ocsigen_response.to_cohttp response
-            and cookies = Ocsigen_response.cookies response in
-            let response =
-              let headers =
-                Cohttp.Header.add_unless_exists
-                  (Cohttp.Header.add_unless_exists
-                     (Ocsigen_cookie_map.Map_path.fold make_cookies_headers
-                        cookies
-                        (Cohttp.Response.headers response))
-                     "server" Ocsigen_config.server_name)
-                  "date"
-                  (Ocsigen_lib.Date.to_string (Unix.time ()))
-              in
-              {response with Cohttp.Response.headers}
-            in
-            Lwt.return (response, body))
+         (fun () -> connector request)
          (function
            | Ocsigen_is_dir fun_request ->
                let headers =
                  fun_request request |> Uri.to_string
                  |> Cohttp.Header.init_with "location"
                and status = `Moved_permanently in
-               Cohttp_lwt_unix.Server.respond ~headers ~status ~body:`Empty ()
-           | exn -> handle_error exn))
+               Lwt.return (Ocsigen_response.respond ~headers ~status ())
+           | exn -> handle_error exn)
+       >>= fun response ->
+       Lwt.return (Ocsigen_response.to_response_expert response))
     (fun () ->
        if !filenames <> []
        then
@@ -236,7 +196,7 @@ let service ?ssl ~address ~port ~connector () =
     let ssl = match ssl with Some _ -> true | None -> false in
     handler ~ssl ~address ~port ~connector
   in
-  let config = Cohttp_lwt_unix.Server.make ~conn_closed ~callback () in
+  let config = Cohttp_lwt_unix.Server.make_expert ~conn_closed ~callback () in
   let mode =
     match address, tls_own_key with
     | `Unix f, _ -> `Unix_domain_socket (`File f)
diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index 462fdf8ce..d5b1fc59d 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -1,15 +1,37 @@
+module Body = struct
+  type t = ((string -> unit Lwt.t) -> unit Lwt.t) * Cohttp.Transfer.encoding
+
+  let empty : t = (fun _write -> Lwt.return_unit), Fixed 0L
+  let make encoding writer = writer, encoding
+
+  let of_cohttp body =
+    ( (fun write -> Cohttp_lwt.Body.write_body write body)
+    , Cohttp_lwt.Body.transfer_encoding body )
+
+  let write (w, _) = w
+  let transfer_encoding = snd
+end
+
 type t =
   { a_response : Cohttp.Response.t
-  ; a_body : Cohttp_lwt.Body.t
+  ; a_body : Body.t
   ; a_cookies : Ocsigen_cookie_map.t }
 
-let make
-      ?(body = Cohttp_lwt.Body.empty)
-      ?(cookies = Ocsigen_cookie_map.empty)
-      a_response
-  =
+let make ?(body = Body.empty) ?(cookies = Ocsigen_cookie_map.empty) a_response =
   {a_response; a_body = body; a_cookies = cookies}
 
+let respond ?headers ~status ?(body = Body.empty) () =
+  let encoding =
+    match headers with
+    | None -> Body.transfer_encoding body
+    | Some headers -> (
+      match Cohttp.Header.get_transfer_encoding headers with
+      | Cohttp.Transfer.Unknown -> Body.transfer_encoding body
+      | t -> t)
+  in
+  let response = Cohttp.Response.make ~status ~encoding ?headers () in
+  make ~body response
+
 let update ?response ?body ?cookies {a_response; a_body; a_cookies} =
   let a_response =
     match response with Some response -> response | None -> a_response
@@ -19,10 +41,53 @@ let update ?response ?body ?cookies {a_response; a_body; a_cookies} =
   in
   {a_response; a_body; a_cookies}
 
-let of_cohttp ?(cookies = Ocsigen_cookie_map.empty) (a_response, a_body) =
+let of_cohttp ?(cookies = Ocsigen_cookie_map.empty) (a_response, body) =
+  let a_body = Body.of_cohttp body in
   {a_response; a_body; a_cookies = cookies}
 
-let to_cohttp {a_response; a_body; _} = a_response, a_body
+(* FIXME: secure *)
+let make_cookies_header path exp name c _secure =
+  Format.sprintf "%s=%s%s%s" name c
+    (*VVV encode = true? *)
+    ("; path=/" ^ Ocsigen_lib.Url.string_of_url_path ~encode:true path)
+    (* (if secure && slot.sl_ssl then "; secure" else "")^ *)
+    ""
+  ^
+  match exp with
+  | Some s -> "; expires=" ^ Ocsigen_lib.Date.to_string s
+  | None -> ""
+
+let make_cookies_headers path t hds =
+  Ocsigen_cookie_map.Map_inner.fold
+    (fun name c h ->
+       let open Ocsigen_cookie_map in
+       let exp, v, secure =
+         match c with
+         | OUnset -> Some 0., "", false
+         | OSet (t, v, secure) -> t, v, secure
+       in
+       Cohttp.Header.add h
+         Ocsigen_header.Name.(to_string set_cookie)
+         (make_cookies_header path exp name v secure))
+    t hds
+
+let to_cohttp_response {a_response; a_cookies; _} =
+  let headers =
+    Cohttp.Header.add_unless_exists
+      (Cohttp.Header.add_unless_exists
+         (Ocsigen_cookie_map.Map_path.fold make_cookies_headers a_cookies
+            (Cohttp.Response.headers a_response))
+         "server" Ocsigen_config.server_name)
+      "date"
+      (Ocsigen_lib.Date.to_string (Unix.time ()))
+  in
+  {a_response with Cohttp.Response.headers}
+
+let to_response_expert t =
+  to_cohttp_response t, fun _ic oc -> fst t.a_body (Lwt_io.write oc)
+
+let response t = t.a_response
+let body t = t.a_body
 
 let status {a_response = {Cohttp.Response.status; _}; _} =
   match status with
diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli
index 1fd00bff1..1d2a95899 100644
--- a/src/server/ocsigen_response.mli
+++ b/src/server/ocsigen_response.mli
@@ -1,14 +1,40 @@
 type t
 
+module Body : sig
+  type t
+
+  val empty : t
+
+  val make :
+     Cohttp.Transfer.encoding
+    -> ((string -> unit Lwt.t) -> unit Lwt.t)
+    -> t
+  (** [make writer] makes a reponse body whose content is generated by
+      [writer write]. [write str] blocks until [str] is fully written. *)
+
+  val of_cohttp : Cohttp_lwt.Body.t -> t
+  val write : t -> (string -> unit Lwt.t) -> unit Lwt.t
+  val transfer_encoding : t -> Cohttp.Transfer.encoding
+end
+
 val make :
-   ?body:Cohttp_lwt.Body.t
+   ?body:Body.t
   -> ?cookies:Ocsigen_cookie_map.t
   -> Cohttp.Response.t
   -> t
 
+val respond :
+   ?headers:Cohttp.Header.t
+  -> status:Http.Status.t
+  -> ?body:Body.t
+  -> unit
+  -> t
+(** Like [make] but with an interface similar to
+    [Cohttp_lwt_unix.Server.respond]. *)
+
 val update :
    ?response:Cohttp.Response.t
-  -> ?body:Cohttp_lwt.Body.t
+  -> ?body:Body.t
   -> ?cookies:Ocsigen_cookie_map.t
   -> t
   -> t
@@ -18,7 +44,13 @@ val of_cohttp :
   -> Cohttp.Response.t * Cohttp_lwt.Body.t
   -> t
 
-val to_cohttp : t -> Cohttp.Response.t * Cohttp_lwt.Body.t
+val to_response_expert :
+   t
+  -> Cohttp.Response.t * ('ic -> Lwt_io.output_channel -> unit Lwt.t)
+(** Response for [Cohttp_lwt_unix.Server.make_expert]. *)
+
+val response : t -> Cohttp.Response.t
+val body : t -> Body.t
 val status : t -> Cohttp.Code.status
 val set_status : t -> Cohttp.Code.status -> t
 val cookies : t -> Ocsigen_cookie_map.t

From 795113447e80624fd742ec3fb53e8cb2a9674370 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 12 May 2025 18:22:57 +0200
Subject: [PATCH 02/12] Deflatemod: Use Ocsigen_response instead of
 Ocsigen_stream

Rewrite 'Deflatemod' to operate on 'Ocsigen_response.Body' directly instead
of on 'Ocsigen_stream'.

'Ocsigen_stream' will no longer be compatible with Cohttp-eio's response
type.
---
 src/extensions/deflatemod.ml | 160 ++++++++++++-----------------------
 1 file changed, 53 insertions(+), 107 deletions(-)

diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml
index b8c7b67a9..c99f44341 100644
--- a/src/extensions/deflatemod.ml
+++ b/src/extensions/deflatemod.ml
@@ -59,131 +59,77 @@ let gzip_header =
 type output_buffer =
   { stream : Zlib.stream
   ; buf : bytes
-  ; mutable pos : int
-  ; mutable avail : int
+  ; flush : string -> unit Lwt.t
   ; mutable size : int32
-  ; mutable crc : int32
-  ; mutable add_trailer : bool }
+  ; mutable crc : int32 }
 
-let write_int32 oz n =
+let write_int32 buf offset n =
   for i = 0 to 3 do
-    Bytes.set oz.buf (oz.pos + i)
+    Bytes.set buf (offset + i)
       (Char.chr (Int32.to_int (Int32.shift_right_logical n (8 * i)) land 0xff))
-  done;
-  oz.pos <- oz.pos + 4;
-  oz.avail <- oz.avail - 4;
-  assert (oz.avail >= 0)
+  done
 
-(* puts in oz the content of buf, from pos to pos + len ;
- * f is the continuation of the current stream *)
-let rec output oz f buf pos len =
-  assert (pos >= 0 && len >= 0 && pos + len <= String.length buf);
-  if oz.avail = 0
-  then (
-    let cont () = output oz f buf pos len in
-    Logs.info ~src:section (fun fmt ->
-      fmt "Flushing because output buffer is full");
-    flush oz cont)
-  else if len = 0
-  then next_cont oz f
+let compress_flush oz used_out = oz.flush (Bytes.sub_string oz.buf 0 used_out)
+
+(* gzip trailer *)
+let write_trailer oz =
+  write_int32 oz.buf 0 oz.crc;
+  write_int32 oz.buf 4 oz.size;
+  compress_flush oz 8
+
+(* puts in oz the content of buf, from pos to pos + len ; *)
+let rec compress_output oz inbuf pos len =
+  if len = 0
+  then Lwt.return_unit
   else
     let (_ : bool), used_in, used_out =
       try
-        Zlib.deflate oz.stream
-          (Bytes.unsafe_of_string buf)
-          pos len oz.buf oz.pos oz.avail Zlib.Z_NO_FLUSH
+        Zlib.deflate_string oz.stream inbuf pos len oz.buf 0
+          (Bytes.length oz.buf) Zlib.Z_NO_FLUSH
       with Zlib.Error (s, s') ->
         raise
           (Ocsigen_stream.Stream_error
              ("Error during compression: " ^ s ^ " " ^ s'))
     in
-    oz.pos <- oz.pos + used_out;
-    oz.avail <- oz.avail - used_out;
-    oz.size <- Int32.add oz.size (Int32.of_int used_in);
-    oz.crc <- Zlib.update_crc_string oz.crc buf pos used_in;
-    output oz f buf (pos + used_in) (len - used_in)
+    compress_flush oz used_out >>= fun () ->
+    compress_output oz inbuf (pos + used_in) (len - used_in)
 
-(* Flush oz, ie. produces a new_stream with the content of oz, cleans it
- * and returns the continuation of the stream *)
-and flush oz cont =
-  let len = oz.pos in
-  if len = 0
-  then cont ()
-  else
-    let buf_len = Bytes.length oz.buf in
-    let s =
-      if len = buf_len
-      then Bytes.to_string oz.buf
-      else Bytes.sub_string oz.buf 0 len
-    in
-    Logs.info ~src:section (fun fmt -> fmt "Flushing!");
-    oz.pos <- 0;
-    oz.avail <- buf_len;
-    Ocsigen_stream.cont s cont
-
-and next_cont oz stream =
-  Ocsigen_stream.next (stream : string Ocsigen_stream.stream) >>= fun e ->
-  match e with
-  | Ocsigen_stream.Finished None ->
-      Logs.info ~src:section (fun fmt ->
-        fmt "End of stream: big cleaning for zlib");
-      (* loop until there is nothing left to compress and flush *)
-      let rec finish () =
-        (* buffer full *)
-        if oz.avail = 0
-        then flush oz finish
-        else
-          (* no more input, deflates only what were left because output buffer
-           * was full *)
-          let finished, (_ : int), used_out =
-            Zlib.deflate oz.stream oz.buf 0 0 oz.buf oz.pos oz.avail
-              Zlib.Z_FINISH
-          in
-          oz.pos <- oz.pos + used_out;
-          oz.avail <- oz.avail - used_out;
-          if not finished then finish () else write_trailer ()
-      and write_trailer () =
-        if oz.add_trailer && oz.avail < 8
-        then flush oz write_trailer
-        else (
-          if oz.add_trailer then (write_int32 oz oz.crc; write_int32 oz oz.size);
-          Logs.info ~src:section (fun fmt ->
-            fmt "Zlib.deflate finished, last flush");
-          flush oz (fun () -> Ocsigen_stream.empty None))
-      in
-      finish ()
-  | Ocsigen_stream.Finished (Some s) -> next_cont oz s
-  | Ocsigen_stream.Cont (s, f) -> output oz f s 0 (String.length s)
+let rec compress_finish oz =
+  (* loop until there is nothing left to compress and flush *)
+  let finished, (_ : int), used_out =
+    Zlib.deflate oz.stream oz.buf 0 0 oz.buf 0 (Bytes.length oz.buf)
+      Zlib.Z_FINISH
+  in
+  compress_flush oz used_out >>= fun () ->
+  if not finished then compress_finish oz else Lwt.return_unit
 
 (* deflate param : true = deflate ; false = gzip (no header in this case) *)
-let compress deflate stream : string Ocsigen_stream.t =
+let compress_body deflate body =
+ fun flush ->
   let zstream = Zlib.deflate_init !compress_level deflate in
-  let finalize status =
-    Ocsigen_stream.finalize stream status >>= fun _e ->
-    (try Zlib.deflate_end zstream
-     with
-     (* ignore errors, deflate_end cleans everything anyway *)
-     | Zlib.Error _ ->
-       ());
-    Lwt.return (Logs.info ~src:section (fun fmt -> fmt "Zlib stream closed"))
-  in
   let oz =
     let buffer_size = !buffer_size in
     { stream = zstream
     ; buf = Bytes.create buffer_size
-    ; pos = 0
-    ; avail = buffer_size
+    ; flush
     ; size = 0l
-    ; crc = 0l
-    ; add_trailer = not deflate }
+    ; crc = 0l }
   in
-  let new_stream () = next_cont oz (Ocsigen_stream.get stream) in
-  Logs.info ~src:section (fun fmt -> fmt "Zlib stream initialized");
-  if deflate
-  then Ocsigen_stream.make ~finalize new_stream
-  else
-    Ocsigen_stream.make ~finalize (fun () ->
-      Ocsigen_stream.cont gzip_header new_stream)
+  (if deflate then Lwt.return_unit else flush gzip_header) >>= fun () ->
+  body (fun inbuf ->
+    let len = String.length inbuf in
+    oz.size <- Int32.add oz.size (Int32.of_int len);
+    oz.crc <- Zlib.update_crc_string oz.crc inbuf 0 len;
+    compress_output oz inbuf 0 len)
+  >>= fun () ->
+  compress_finish oz >>= fun () ->
+  (if deflate then Lwt.return_unit else write_trailer oz) >>= fun () ->
+  (try Zlib.deflate_end zstream
+   with
+   (* ignore errors, deflate_end cleans everything anyway *)
+   | Zlib.Error _ ->
+     ());
+  Lwt.return_unit
 
 (* We implement Content-Encoding, not Transfer-Encoding *)
 type encoding = Deflate | Gzip | Id | Star | Not_acceptable
@@ -252,8 +198,8 @@ let stream_filter contentencoding url deflate choice res =
                match Ocsigen_header.Mime_type.parse contenttype with
                | None, _ | _, None -> Lwt.return res
                | Some a, Some b when should_compress (a, b) url choice ->
-                   let response, body = Ocsigen_response.to_cohttp res in
                    let response =
+                     let response = Ocsigen_response.response res in
                      let headers = Cohttp.Response.headers response in
                      let headers =
                        let name = Ocsigen_header.Name.(to_string etag) in
@@ -273,10 +219,10 @@ let stream_filter contentencoding url deflate choice res =
                        Cohttp.Response.headers
                      ; Cohttp.Response.encoding = Cohttp.Transfer.Chunked }
                    and body =
-                     Cohttp_lwt.Body.to_stream body
-                     |> Ocsigen_stream.of_lwt_stream |> compress deflate
-                     |> Ocsigen_stream.to_lwt_stream
-                     |> Cohttp_lwt.Body.of_stream
+                     Ocsigen_response.Body.make Cohttp.Transfer.Chunked
+                       (compress_body deflate
+                          (Ocsigen_response.Body.write
+                             (Ocsigen_response.body res)))
                    in
                    Lwt.return (Ocsigen_response.update res ~body ~response)
                | _ -> Lwt.return res)

From 5f47088be7fddc075f91d05136cb15771cdb642b Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Mon, 12 May 2025 18:35:15 +0200
Subject: [PATCH 03/12] Ocsigen_response: Add Body.of_string

---
 src/server/ocsigen_response.ml  | 9 +++++++--
 src/server/ocsigen_response.mli | 5 ++++-
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index d5b1fc59d..4c284fb1b 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -1,8 +1,13 @@
 module Body = struct
   type t = ((string -> unit Lwt.t) -> unit Lwt.t) * Cohttp.Transfer.encoding
 
-  let empty : t = (fun _write -> Lwt.return_unit), Fixed 0L
-  let make encoding writer = writer, encoding
+  let make encoding writer : t = writer, encoding
+  let empty = make (Fixed 0L) (fun _write -> Lwt.return_unit)
+
+  let of_string s =
+    make
+      (Cohttp.Transfer.Fixed (Int64.of_int (String.length s)))
+      (fun write -> write s)
 
   let of_cohttp body =
     ( (fun write -> Cohttp_lwt.Body.write_body write body)
diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli
index 1d2a95899..b7b62362b 100644
--- a/src/server/ocsigen_response.mli
+++ b/src/server/ocsigen_response.mli
@@ -4,6 +4,7 @@ module Body : sig
   type t
 
   val empty : t
+  val of_string : string -> t
 
   val make :
      Cohttp.Transfer.encoding
@@ -47,9 +48,11 @@ val of_cohttp :
 val to_response_expert :
    t
   -> Cohttp.Response.t * ('ic -> Lwt_io.output_channel -> unit Lwt.t)
-(** Response for [Cohttp_lwt_unix.Server.make_expert]. *)
+(** Response for [Cohttp_lwt_unix.Server.make_expert]. Set cookie headers. *)
 
 val response : t -> Cohttp.Response.t
+(** Raw response without cookie headers set. *)
+
 val body : t -> Body.t
 val status : t -> Cohttp.Code.status
 val set_status : t -> Cohttp.Code.status -> t

From b3c8011fd089a829a8e9bd1f750836b4916c6da2 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 13 May 2025 14:07:26 +0200
Subject: [PATCH 04/12] Add 'http' to SERVER_PACKAGE

---
 Makefile.options                    | 2 +-
 src/files/ocsigenserver.conf/gen.ml | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/Makefile.options b/Makefile.options
index 3def3efc4..691adb93b 100644
--- a/Makefile.options
+++ b/Makefile.options
@@ -23,6 +23,6 @@ INCS=   -I ${BLD}/server/.ocsigenserver.objs/byte \
 ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable
 ## but also to generate src/baselib/ocsigen_config_static.ml
 
-SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,logs,logs-syslog,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix
+SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,logs,logs-syslog,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix,http
 
 LIBS := -package ${SERVER_PACKAGE} ${INCS}
diff --git a/src/files/ocsigenserver.conf/gen.ml b/src/files/ocsigenserver.conf/gen.ml
index 73f2628a0..c2e58f68c 100644
--- a/src/files/ocsigenserver.conf/gen.ml
+++ b/src/files/ocsigenserver.conf/gen.ml
@@ -84,7 +84,7 @@ let deps () =
     ; "ocsigenserver" ]
   in
   let packages =
-    "lwt_ssl,bytes,lwt.unix,logs,logs-syslog.unix,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix"
+    "lwt_ssl,bytes,lwt.unix,logs,logs-syslog.unix,syslog-message,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix,http"
   in
   let deps = ref [] in
   let cmd = "ocamlfind query -p-format -recursive " ^ packages in

From fc3547b9e21f55cacf7fca8de329d765008e3222 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Tue, 13 May 2025 15:25:04 +0200
Subject: [PATCH 05/12] Deflatemod: Add debug logs

---
 src/extensions/deflatemod.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml
index c99f44341..356a35a27 100644
--- a/src/extensions/deflatemod.ml
+++ b/src/extensions/deflatemod.ml
@@ -69,7 +69,9 @@ let write_int32 buf offset n =
       (Char.chr (Int32.to_int (Int32.shift_right_logical n (8 * i)) land 0xff))
   done
 
-let compress_flush oz used_out = oz.flush (Bytes.sub_string oz.buf 0 used_out)
+let compress_flush oz used_out =
+  Logs.debug ~src:section (fun fmt -> fmt "Flushing %d bytes" used_out);
+  oz.flush (Bytes.sub_string oz.buf 0 used_out)
 
 (* gzip trailer *)
 let write_trailer oz =
@@ -95,6 +97,7 @@ let rec compress_output oz inbuf pos len =
     compress_output oz inbuf (pos + used_in) (len - used_in)
 
 let rec compress_finish oz =
+  Logs.debug ~src:section (fun fmt -> fmt "Finishing");
   (* loop until there is nothing left to compress and flush *)
   let finished, (_ : int), used_out =
     Zlib.deflate oz.stream oz.buf 0 0 oz.buf 0 (Bytes.length oz.buf)
@@ -124,6 +127,7 @@ let compress_body deflate body =
   >>= fun () ->
   compress_finish oz >>= fun () ->
   (if deflate then Lwt.return_unit else write_trailer oz) >>= fun () ->
+  Logs.debug ~src:section (fun fmt -> fmt "Close stream");
   (try Zlib.deflate_end zstream
    with
    (* ignore errors, deflate_end cleans everything anyway *)

From 4adb9e812df36edf8b5fec9f63432a8b9b95d7e5 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 14 May 2025 15:34:56 +0200
Subject: [PATCH 06/12] Deflatemod: Don't flush when buffer is empty

---
 src/extensions/deflatemod.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml
index 356a35a27..2ca4adfe5 100644
--- a/src/extensions/deflatemod.ml
+++ b/src/extensions/deflatemod.ml
@@ -71,7 +71,9 @@ let write_int32 buf offset n =
 
 let compress_flush oz used_out =
   Logs.debug ~src:section (fun fmt -> fmt "Flushing %d bytes" used_out);
-  oz.flush (Bytes.sub_string oz.buf 0 used_out)
+  if used_out > 0
+  then oz.flush (Bytes.sub_string oz.buf 0 used_out)
+  else Lwt.return_unit
 
 (* gzip trailer *)
 let write_trailer oz =

From 2b91cf3194071cee550fca4dba8d2b4cd6707abc Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 16 May 2025 16:24:12 +0200
Subject: [PATCH 07/12] Ocsigen_response: Fix well-formedness of response body

---
 src/server/ocsigen_response.ml | 41 +++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 15 deletions(-)

diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index 4c284fb1b..e5e78bbc6 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -1,12 +1,15 @@
+open Cohttp
+open Lwt.Syntax
+
 module Body = struct
-  type t = ((string -> unit Lwt.t) -> unit Lwt.t) * Cohttp.Transfer.encoding
+  type t = ((string -> unit Lwt.t) -> unit Lwt.t) * Transfer.encoding
 
   let make encoding writer : t = writer, encoding
   let empty = make (Fixed 0L) (fun _write -> Lwt.return_unit)
 
   let of_string s =
     make
-      (Cohttp.Transfer.Fixed (Int64.of_int (String.length s)))
+      (Transfer.Fixed (Int64.of_int (String.length s)))
       (fun write -> write s)
 
   let of_cohttp body =
@@ -18,9 +21,7 @@ module Body = struct
 end
 
 type t =
-  { a_response : Cohttp.Response.t
-  ; a_body : Body.t
-  ; a_cookies : Ocsigen_cookie_map.t }
+  {a_response : Response.t; a_body : Body.t; a_cookies : Ocsigen_cookie_map.t}
 
 let make ?(body = Body.empty) ?(cookies = Ocsigen_cookie_map.empty) a_response =
   {a_response; a_body = body; a_cookies = cookies}
@@ -76,20 +77,30 @@ 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; _} =
+let to_cohttp_response {a_response; a_cookies; a_body = _} =
   let headers =
-    Cohttp.Header.add_unless_exists
-      (Cohttp.Header.add_unless_exists
-         (Ocsigen_cookie_map.Map_path.fold make_cookies_headers a_cookies
-            (Cohttp.Response.headers a_response))
-         "server" Ocsigen_config.server_name)
-      "date"
-      (Ocsigen_lib.Date.to_string (Unix.time ()))
+    let add name value headers = Header.add_unless_exists headers name value 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 ()))
   in
-  {a_response with Cohttp.Response.headers}
+  {a_response with Response.headers}
 
 let to_response_expert t =
-  to_cohttp_response t, fun _ic oc -> fst t.a_body (Lwt_io.write oc)
+  let module R = Cohttp_lwt_unix.Response in
+  let write_footer {R.encoding; _} oc =
+    (* Copied from [cohttp/response.ml]. *)
+    match encoding with
+    | Transfer.Chunked -> Lwt_io.write oc "0\r\n\r\n"
+    | Transfer.Fixed _ | Transfer.Unknown -> Lwt.return_unit
+  in
+  let res = to_cohttp_response t in
+  ( 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 response t = t.a_response
 let body t = t.a_body

From 5b7b27b935c8c09c425b4ef55364dbd5b035f1f8 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 16 May 2025 16:37:16 +0200
Subject: [PATCH 08/12] Add dependency to package 'http'

---
 configure          | 1 +
 dune-project       | 1 +
 ocsigenserver.opam | 1 +
 3 files changed, 3 insertions(+)

diff --git a/configure b/configure
index 509686f1f..1ddf344a4 100755
--- a/configure
+++ b/configure
@@ -396,6 +396,7 @@ check_library cohttp "See: https://github.com/mirage/ocaml-cohttp"
 check_library cohttp-lwt-unix "Missing support for 'lwt' in cohttp."
 check_library react "See: http://erratique.ch/software/react"
 check_library ssl "See: http://sourceforge.net/projects/savonet/files/ocaml-ssl"
+check_library http ""
 
 check_library lwt "See: http://ocsigen.org/lwt"
 check_library lwt.unix  "Missing support for 'unix' in lwt."
diff --git a/dune-project b/dune-project
index ec68a49a8..9e0b44e7f 100644
--- a/dune-project
+++ b/dune-project
@@ -20,6 +20,7 @@
   (camlzip (>= 1.04))
   (cohttp-lwt-unix (and (>= 5.0) (< 6.0)))
   (conduit-lwt-unix (and (>= 2.0) (< 7.0)))
+  http
   cryptokit
   (ipaddr (>= 2.1))
   (lwt (>= 3.0))
diff --git a/ocsigenserver.opam b/ocsigenserver.opam
index f8959cf3b..ef989a6dd 100644
--- a/ocsigenserver.opam
+++ b/ocsigenserver.opam
@@ -15,6 +15,7 @@ depends: [
   "camlzip" {>= "1.04"}
   "cohttp-lwt-unix" {>= "5.0" & < "6.0"}
   "conduit-lwt-unix" {>= "2.0" & < "7.0"}
+  "http"
   "cryptokit"
   "ipaddr" {>= "2.1"}
   "lwt" {>= "3.0"}

From a59d4aa65af47a4bc7c277e7562abeadbfb3d76e Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 21 May 2025 19:14:22 +0200
Subject: [PATCH 09/12] Ocsigen_response: Add 'response_string' and
 'response_error'

This adds functions from `Cohttp_lwt_unix.Server` that are no longer
available with cohttp-eio.
---
 src/server/ocsigen_cohttp.ml    |  8 ++++----
 src/server/ocsigen_response.ml  |  9 +++++++++
 src/server/ocsigen_response.mli | 19 +++++++++++++++++++
 3 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml
index c2405e149..c0e79fed5 100644
--- a/src/server/ocsigen_cohttp.ml
+++ b/src/server/ocsigen_cohttp.ml
@@ -104,10 +104,9 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
       | `Not_found -> "Not Found"
       | _ -> Printexc.to_string exn
     in
-    Cohttp_lwt_unix.Server.respond_error ?headers
+    Ocsigen_response.respond_error ?headers
       ~status:(ret_code :> Cohttp.Code.status_code)
       ~body ()
-    >>= fun resp -> Lwt.return (Ocsigen_response.of_cohttp resp)
   in
   (* TODO: equivalent of Ocsigen_range *)
   let request =
@@ -137,8 +136,9 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
                  fun_request request |> Uri.to_string
                  |> Cohttp.Header.init_with "location"
                and status = `Moved_permanently in
-               Lwt.return (Ocsigen_response.respond ~headers ~status ())
-           | exn -> handle_error exn)
+               Lwt.return
+                 (Ocsigen_response.respond_string ~headers ~status ~body:"" ())
+           | exn -> Lwt.return (handle_error exn))
        >>= fun response ->
        Lwt.return (Ocsigen_response.to_response_expert response))
     (fun () ->
diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index e5e78bbc6..8efff9c3a 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -38,6 +38,15 @@ let respond ?headers ~status ?(body = Body.empty) () =
   let response = Cohttp.Response.make ~status ~encoding ?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 body = Body.of_string body in
+  make ~body response
+
+let respond_error ?headers ?(status = `Internal_server_error) ~body () =
+  respond_string ?headers ~status ~body:("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
diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli
index b7b62362b..ef125da4f 100644
--- a/src/server/ocsigen_response.mli
+++ b/src/server/ocsigen_response.mli
@@ -33,6 +33,25 @@ val respond :
 (** Like [make] but with an interface similar to
     [Cohttp_lwt_unix.Server.respond]. *)
 
+val respond_string :
+   ?headers:Cohttp.Header.t
+  -> status:Http.Status.t
+  -> body:string
+  -> unit
+  -> t
+(** Like [respond] but with a fixed string body. *)
+
+val respond_error :
+   ?headers:Cohttp.Header.t
+  -> ?status:Http.Status.t
+  -> body:string
+  -> unit
+  -> t
+(** Like [respond_string] with ["Error: "] appended to the body. The default
+    status is [`Internal_server_error].
+
+    @deprecated Use [respond_string] with a [~status] argument instead. *)
+
 val update :
    ?response:Cohttp.Response.t
   -> ?body:Body.t

From 6209028c1b541d2f01804f14829a711b8cb3c23b Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Wed, 21 May 2025 19:21:18 +0200
Subject: [PATCH 10/12] Ocsigen_response: Propagate the transfer encoding

In cohttp-eio, the transfer encoding is no longer propagated through the
`Body.t` type. Instead, it must be propagated separately.
---
 src/server/ocsigen_response.ml  | 16 ++++++++--------
 src/server/ocsigen_response.mli |  3 ++-
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index 8efff9c3a..84fe9dcff 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -12,9 +12,8 @@ module Body = struct
       (Transfer.Fixed (Int64.of_int (String.length s)))
       (fun write -> write s)
 
-  let of_cohttp body =
-    ( (fun write -> Cohttp_lwt.Body.write_body write body)
-    , Cohttp_lwt.Body.transfer_encoding body )
+  let of_cohttp ~encoding body =
+    (fun write -> Cohttp_lwt.Body.write_body write body), encoding
 
   let write (w, _) = w
   let transfer_encoding = snd
@@ -26,16 +25,16 @@ type t =
 let make ?(body = Body.empty) ?(cookies = Ocsigen_cookie_map.empty) a_response =
   {a_response; a_body = body; a_cookies = cookies}
 
-let respond ?headers ~status ?(body = Body.empty) () =
+let respond ?headers ~status ~encoding ?(body = Body.empty) () =
   let encoding =
     match headers with
-    | None -> Body.transfer_encoding body
+    | None -> encoding
     | Some headers -> (
       match Cohttp.Header.get_transfer_encoding headers with
-      | Cohttp.Transfer.Unknown -> Body.transfer_encoding body
+      | Cohttp.Transfer.Unknown -> encoding
       | t -> t)
   in
-  let response = Cohttp.Response.make ~status ~encoding ?headers () in
+  let response = Response.make ~status ~encoding ?headers () in
   make ~body response
 
 let respond_string ?headers ~status ~body () =
@@ -57,7 +56,8 @@ let update ?response ?body ?cookies {a_response; a_body; a_cookies} =
   {a_response; a_body; a_cookies}
 
 let of_cohttp ?(cookies = Ocsigen_cookie_map.empty) (a_response, body) =
-  let a_body = Body.of_cohttp body in
+  let encoding = Response.encoding a_response in
+  let a_body = Body.of_cohttp ~encoding body in
   {a_response; a_body; a_cookies = cookies}
 
 (* FIXME: secure *)
diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli
index ef125da4f..8ecb48acc 100644
--- a/src/server/ocsigen_response.mli
+++ b/src/server/ocsigen_response.mli
@@ -13,7 +13,7 @@ module Body : sig
   (** [make writer] makes a reponse body whose content is generated by
       [writer write]. [write str] blocks until [str] is fully written. *)
 
-  val of_cohttp : Cohttp_lwt.Body.t -> t
+  val of_cohttp : encoding:Cohttp.Transfer.encoding -> Cohttp_lwt.Body.t -> t
   val write : t -> (string -> unit Lwt.t) -> unit Lwt.t
   val transfer_encoding : t -> Cohttp.Transfer.encoding
 end
@@ -27,6 +27,7 @@ val make :
 val respond :
    ?headers:Cohttp.Header.t
   -> status:Http.Status.t
+  -> encoding:Cohttp.Transfer.encoding
   -> ?body:Body.t
   -> unit
   -> t

From a4d22c4d6217b1131575cb558cbdcf3c46264ddf Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 12 Jun 2025 12:09:42 +0200
Subject: [PATCH 11/12] Promote tests

---
 test/extensions/deflatemod.t/run.t | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/test/extensions/deflatemod.t/run.t b/test/extensions/deflatemod.t/run.t
index f6f2c5adb..94368ce2d 100644
--- a/test/extensions/deflatemod.t/run.t
+++ b/test/extensions/deflatemod.t/run.t
@@ -14,11 +14,6 @@
   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:ext:deflate: [INFO] Zlib stream initialized
-  ocsigen:ext:deflate: [INFO] End of stream: big cleaning for zlib
-  ocsigen:ext:deflate: [INFO] Zlib.deflate finished, last flush
-  ocsigen:ext:deflate: [INFO] Flushing!
-  ocsigen:ext:deflate: [INFO] Zlib stream closed
   application: [WARNING] Command received: shutdown
 
 First response is not compressed:

From 480d5e6ebc2d84f723213019bb940320021cd152 Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Thu, 12 Jun 2025 14:31:31 +0200
Subject: [PATCH 12/12] Ocsigen_response: Mention possible optimisation

---
 src/server/ocsigen_response.ml | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml
index 84fe9dcff..d9e5fe7d2 100644
--- a/src/server/ocsigen_response.ml
+++ b/src/server/ocsigen_response.ml
@@ -2,6 +2,10 @@ open Cohttp
 open Lwt.Syntax
 
 module Body = struct
+  (* TODO: Avoid copies by passing buffers directly. This API was choosen
+     because it is closer to [Lwt_stream] which was used before. This type
+     forces data to be copied from buffers (usually [bytes]) to immutable
+     strings, which is unecessary. *)
   type t = ((string -> unit Lwt.t) -> unit Lwt.t) * Transfer.encoding
 
   let make encoding writer : t = writer, encoding