From e00c3a5d63f452990f5bf03b234965377a49c557 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 3 Jun 2023 22:45:02 -0400
Subject: [PATCH 01/22] wip: tiny_httpd_eio, an alternative IO/concurrency
 backend based on Eio

---
 src/eio/dune               |   8 +++
 src/eio/tiny_httpd_eio.ml  | 134 +++++++++++++++++++++++++++++++++++++
 src/eio/tiny_httpd_eio.mli |  21 ++++++
 tiny_httpd_eio.opam        |  22 ++++++
 4 files changed, 185 insertions(+)
 create mode 100644 src/eio/dune
 create mode 100644 src/eio/tiny_httpd_eio.ml
 create mode 100644 src/eio/tiny_httpd_eio.mli
 create mode 100644 tiny_httpd_eio.opam

diff --git a/src/eio/dune b/src/eio/dune
new file mode 100644
index 00000000..5ecf5128
--- /dev/null
+++ b/src/eio/dune
@@ -0,0 +1,8 @@
+
+(library
+  (name tiny_httpd_eio)
+  (public_name tiny_httpd_eio)
+  (synopsis "An EIO-based backend for Tiny_httpd")
+  (flags :standard -safe-string -warn-error -a+8)
+  (libraries tiny_httpd eio))
+
diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
new file mode 100644
index 00000000..25267780
--- /dev/null
+++ b/src/eio/tiny_httpd_eio.ml
@@ -0,0 +1,134 @@
+module IO = Tiny_httpd_io
+module H = Tiny_httpd_server
+
+let ( let@ ) = ( @@ )
+
+type 'a with_args =
+  ?addr:string ->
+  ?port:int ->
+  ?max_connections:int ->
+  stdenv:Eio.Stdenv.t ->
+  sw:Eio.Switch.t ->
+  'a
+
+let get_max_connection_ ?(max_connections = 64) () : int =
+  let max_connections = max 4 max_connections in
+  max_connections
+
+let read_buf_size = 4 * 1024
+let write_buf_size = 8 * 1024
+
+let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t =
+  let cstruct = Cstruct.create write_buf_size in
+  let input buf i len =
+    if len = 0 then
+      0
+    else (
+      let n = flow#read_into (Cstruct.sub cstruct 0 (min len write_buf_size)) in
+      Cstruct.blit_to_bytes cstruct 0 buf i n;
+      n
+    )
+  in
+  let close () = flow#shutdown `Receive in
+  { IO.In_channel.input; close }
+
+let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
+  let output buf i len =
+    if len > 0 then (
+      let i = ref i in
+      let len = ref len in
+
+      let src =
+        object
+          inherit Eio.Flow.source
+
+          method read_into (cstruct : Cstruct.t) : int =
+            if !len = 0 then raise End_of_file;
+            let n = min !len (Cstruct.length cstruct) in
+            Cstruct.blit_from_bytes buf !i cstruct 0 n;
+            i := !i + n;
+            len := !len - n;
+            n
+        end
+      in
+
+      flow#copy src
+    )
+  in
+  let close () = flow#shutdown `Send in
+  let flush () = () in
+  { IO.Out_channel.close; flush; output }
+
+let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
+    ~(stdenv : Eio.Stdenv.t) ~(sw : Eio.Switch.t) () : (module H.IO_BACKEND) =
+  let module M = struct
+    let init_addr () = addr
+    let init_port () = port
+
+    let get_time_s () =
+      let clock = Eio.Stdenv.clock stdenv in
+      Eio.Time.now clock
+
+    let spawn f : unit =
+      Eio.Switch.run @@ fun sub_sw -> Eio.Fiber.fork ~sw:sub_sw f
+
+    let tcp_server () : IO.TCP_server.builder =
+      {
+        IO.TCP_server.serve =
+          (fun ~after_init ~handle () : unit ->
+            let ip_addr = Eio.Net.Ipaddr.V4.any in
+            let running = Atomic.make true in
+            let active_conns = Atomic.make 0 in
+
+            Eio.Switch.on_release sw (fun () -> Atomic.set running false);
+            let net = Eio.Stdenv.net stdenv in
+
+            (* main server socket *)
+            let sock =
+              let backlog = get_max_connection_ ?max_connections () in
+              Eio.Net.listen ~reuse_addr:true ~reuse_port:true ~backlog ~sw net
+                (`Tcp (ip_addr, port))
+            in
+
+            let tcp_server : IO.TCP_server.t =
+              {
+                running = (fun () -> Atomic.get running);
+                stop = (fun () -> Atomic.set running false);
+                endpoint =
+                  (fun () ->
+                    (* TODO: find the real port *)
+                    addr, port);
+                active_connections = (fun () -> Atomic.get active_conns);
+              }
+            in
+
+            after_init tcp_server;
+
+            while Atomic.get running do
+              Eio.Switch.check sw;
+
+              Eio.Net.accept_fork ~sw
+                ~on_error:(fun exn ->
+                  H._debug (fun k ->
+                      k "error in client handler: %s" (Printexc.to_string exn)))
+                sock
+                (fun flow _client_addr ->
+                  Atomic.incr active_conns;
+                  let@ () =
+                    Fun.protect ~finally:(fun () ->
+                        H._debug (fun k ->
+                            k "Tiny_httpd_eio: client handler returned");
+                        Atomic.decr active_conns)
+                  in
+                  let ic = ic_of_flow flow in
+                  let oc = oc_of_flow flow in
+                  handle.handle ic oc)
+            done);
+      }
+  end in
+  (module M)
+
+let create ?addr ?port ?max_connections ~stdenv ~sw ?buf_size ?middlewares () :
+    H.t =
+  let backend = io_backend ?addr ?port ?max_connections ~stdenv ~sw () in
+  H.create_from ?buf_size ?middlewares ~backend ()
diff --git a/src/eio/tiny_httpd_eio.mli b/src/eio/tiny_httpd_eio.mli
new file mode 100644
index 00000000..c79f0525
--- /dev/null
+++ b/src/eio/tiny_httpd_eio.mli
@@ -0,0 +1,21 @@
+(* TODO: pass in a switch *)
+
+type 'a with_args =
+  ?addr:string ->
+  ?port:int ->
+  ?max_connections:int ->
+  stdenv:Eio.Stdenv.t ->
+  sw:Eio.Switch.t ->
+  'a
+
+val io_backend : (unit -> (module Tiny_httpd_server.IO_BACKEND)) with_args
+(** Create a server *)
+
+val create :
+  (?buf_size:int ->
+  ?middlewares:
+    ([ `Encoding | `Stage of int ] * Tiny_httpd_server.Middleware.t) list ->
+  unit ->
+  Tiny_httpd_server.t)
+  with_args
+(** Create a server *)
diff --git a/tiny_httpd_eio.opam b/tiny_httpd_eio.opam
new file mode 100644
index 00000000..8edeb893
--- /dev/null
+++ b/tiny_httpd_eio.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+version: "0.13"
+authors: ["Simon Cruanes"]
+maintainer: "simon.cruanes.2007@m4x.org"
+license: "MIT"
+synopsis: "Run tiny_httpd on Eio"
+build: [
+  ["dune" "build" "@install" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name] {with-doc}
+  ["dune" "runtest" "-p" name] {with-test}
+]
+depends: [
+  "dune" { >= "2.0" }
+  "eio" {>= "0.9"}
+  "tiny_httpd" { = version }
+  "odoc" {with-doc}
+]
+tags: [ "http" "server" "eio" ]
+homepage: "https://github.com/c-cube/tiny_httpd/"
+doc: "https://c-cube.github.io/tiny_httpd/"
+bug-reports: "https://github.com/c-cube/tiny_httpd/issues"
+dev-repo: "git+https://github.com/c-cube/tiny_httpd.git"

From bfe5e9c35825b434186a3e2fa21a39ada8e8e67f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 3 Jun 2023 22:45:27 -0400
Subject: [PATCH 02/22] copy example `echo` for eio backend

---
 echo_eio.sh          |   2 +
 examples/dune        |   7 ++
 examples/echo_eio.ml | 187 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 196 insertions(+)
 create mode 100755 echo_eio.sh
 create mode 100644 examples/echo_eio.ml

diff --git a/echo_eio.sh b/echo_eio.sh
new file mode 100755
index 00000000..5621bddc
--- /dev/null
+++ b/echo_eio.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec dune exec --display=quiet --profile=release "examples/echo_eio.exe" -- $@
diff --git a/examples/dune b/examples/dune
index da1cd96d..d01f32db 100644
--- a/examples/dune
+++ b/examples/dune
@@ -14,6 +14,13 @@
  (modules echo vfs)
  (libraries tiny_httpd tiny_httpd_camlzip))
 
+(executable
+ (name echo_eio)
+ (flags :standard -warn-error -a+8)
+ (modules echo_eio)
+ (libraries tiny_httpd tiny_httpd_camlzip
+            tiny_httpd_eio eio eio_main))
+
 (rule
  (targets test_output.txt)
  (deps
diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
new file mode 100644
index 00000000..99013308
--- /dev/null
+++ b/examples/echo_eio.ml
@@ -0,0 +1,187 @@
+module S = Tiny_httpd
+module S_eio = Tiny_httpd_eio
+
+let now_ = Unix.gettimeofday
+let ( let@ ) = ( @@ )
+
+(* util: a little middleware collecting statistics *)
+let middleware_stat () : S.Middleware.t * (unit -> string) =
+  let n_req = ref 0 in
+  let total_time_ = ref 0. in
+  let parse_time_ = ref 0. in
+  let build_time_ = ref 0. in
+  let write_time_ = ref 0. in
+
+  let m h req ~resp =
+    incr n_req;
+    let t1 = S.Request.start_time req in
+    let t2 = now_ () in
+    h req ~resp:(fun response ->
+        let t3 = now_ () in
+        resp response;
+        let t4 = now_ () in
+        total_time_ := !total_time_ +. (t4 -. t1);
+        parse_time_ := !parse_time_ +. (t2 -. t1);
+        build_time_ := !build_time_ +. (t3 -. t2);
+        write_time_ := !write_time_ +. (t4 -. t3))
+  and get_stat () =
+    Printf.sprintf
+      "%d requests (average response time: %.3fms = %.3fms + %.3fms + %.3fms)"
+      !n_req
+      (!total_time_ /. float !n_req *. 1e3)
+      (!parse_time_ /. float !n_req *. 1e3)
+      (!build_time_ /. float !n_req *. 1e3)
+      (!write_time_ /. float !n_req *. 1e3)
+  in
+  m, get_stat
+
+let () =
+  let port_ = ref 8080 in
+  let j = ref 32 in
+  Arg.parse
+    (Arg.align
+       [
+         "--port", Arg.Set_int port_, " set port";
+         "-p", Arg.Set_int port_, " set port";
+         "--debug", Arg.Unit (fun () -> S._enable_debug true), " enable debug";
+         "-j", Arg.Set_int j, " maximum number of connections";
+       ])
+    (fun _ -> raise (Arg.Bad ""))
+    "echo [option]*";
+
+  (* use eio *)
+  let@ stdenv = Eio_main.run in
+  let@ sw = Eio.Switch.run in
+
+  (* create server *)
+  let server : S.t =
+    S_eio.create ~port:!port_ ~max_connections:!j ~stdenv ~sw ()
+  in
+
+  (* TODO: re-enable
+     Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server; *)
+  let m_stats, get_stats = middleware_stat () in
+  S.add_middleware server ~stage:(`Stage 1) m_stats;
+
+  (* say hello *)
+  S.add_route_handler ~meth:`GET server
+    S.Route.(exact "hello" @/ string @/ return)
+    (fun name _req -> S.Response.make_string (Ok ("hello " ^ name ^ "!\n")));
+
+  (* compressed file access *)
+  S.add_route_handler ~meth:`GET server
+    S.Route.(exact "zcat" @/ string_urlencoded @/ return)
+    (fun path _req ->
+      let ic = open_in path in
+      let str = S.Byte_stream.of_chan ic in
+      let mime_type =
+        try
+          let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" path) in
+          try
+            let s = [ "Content-Type", String.trim (input_line p) ] in
+            ignore @@ Unix.close_process_in p;
+            s
+          with _ ->
+            ignore @@ Unix.close_process_in p;
+            []
+        with _ -> []
+      in
+      S.Response.make_stream ~headers:mime_type (Ok str));
+
+  (* echo request *)
+  S.add_route_handler server
+    S.Route.(exact "echo" @/ return)
+    (fun req ->
+      let q =
+        S.Request.query req
+        |> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v)
+        |> String.concat ";"
+      in
+      S.Response.make_string
+        (Ok (Format.asprintf "echo:@ %a@ (query: %s)@." S.Request.pp req q)));
+
+  (* file upload *)
+  S.add_route_handler_stream ~meth:`PUT server
+    S.Route.(exact "upload" @/ string @/ return)
+    (fun path req ->
+      S._debug (fun k ->
+          k "start upload %S, headers:\n%s\n\n%!" path
+            (Format.asprintf "%a" S.Headers.pp (S.Request.headers req)));
+      try
+        let oc = open_out @@ "/tmp/" ^ path in
+        S.Byte_stream.to_chan oc req.S.Request.body;
+        flush oc;
+        S.Response.make_string (Ok "uploaded file")
+      with e ->
+        S.Response.fail ~code:500 "couldn't upload file: %s"
+          (Printexc.to_string e));
+
+  (* stats *)
+  S.add_route_handler server
+    S.Route.(exact "stats" @/ return)
+    (fun _req ->
+      let stats = get_stats () in
+      S.Response.make_string @@ Ok stats);
+
+  (* main page *)
+  S.add_route_handler server
+    S.Route.(return)
+    (fun _req ->
+      let open Tiny_httpd_html in
+      let h =
+        html []
+          [
+            head [] [ title [] [ txt "index of echo" ] ];
+            body []
+              [
+                h3 [] [ txt "welcome!" ];
+                p [] [ b [] [ txt "endpoints are:" ] ];
+                ul []
+                  [
+                    li [] [ pre [] [ txt "/hello/:name (GET)" ] ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/echo/" ] [ txt "echo" ];
+                            txt " echo back query";
+                          ];
+                      ];
+                    li []
+                      [ pre [] [ txt "/upload/:path (PUT) to upload a file" ] ];
+                    li []
+                      [
+                        pre []
+                          [
+                            txt
+                              "/zcat/:path (GET) to download a file (deflate \
+                               transfer-encoding)";
+                          ];
+                      ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/stats/" ] [ txt "/stats/" ];
+                            txt " (GET) to access statistics";
+                          ];
+                      ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/vfs/" ] [ txt "/vfs" ];
+                            txt " (GET) to access a VFS embedded in the binary";
+                          ];
+                      ];
+                  ];
+              ];
+          ]
+      in
+      let s = to_string_top h in
+      S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s);
+
+  Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
+  match S.run server with
+  | Ok () -> ()
+  | Error e -> raise e

From 8620fe688d7b3007adff8c1ef13089877fe4860b Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 00:02:20 -0400
Subject: [PATCH 03/22] eio: reimplement some buffering

---
 src/eio/tiny_httpd_eio.ml | 88 +++++++++++++++++++++++++++++++--------
 1 file changed, 70 insertions(+), 18 deletions(-)

diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
index 25267780..6967efc3 100644
--- a/src/eio/tiny_httpd_eio.ml
+++ b/src/eio/tiny_httpd_eio.ml
@@ -15,28 +15,68 @@ let get_max_connection_ ?(max_connections = 64) () : int =
   let max_connections = max 4 max_connections in
   max_connections
 
-let read_buf_size = 4 * 1024
-let write_buf_size = 8 * 1024
+let buf_size = 16 * 1024
 
 let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t =
-  let cstruct = Cstruct.create write_buf_size in
+  let cstruct = Cstruct.create buf_size in
+  let len_slice = ref 0 in
+  let offset = ref 0 in
+
   let input buf i len =
     if len = 0 then
       0
     else (
-      let n = flow#read_into (Cstruct.sub cstruct 0 (min len write_buf_size)) in
-      Cstruct.blit_to_bytes cstruct 0 buf i n;
-      n
+      let available = ref (!len_slice - !offset) in
+      if !available = 0 then (
+        let n = flow#read_into cstruct in
+        offset := 0;
+        len_slice := n;
+        available := n
+      );
+
+      let n = min !available len in
+      if n > 0 then (
+        Cstruct.blit_to_bytes cstruct !offset buf i n;
+        offset := !offset + n;
+        n
+      ) else
+        0
     )
   in
   let close () = flow#shutdown `Receive in
   { IO.In_channel.input; close }
 
-let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
+(*
+
   let output buf i len =
-    if len > 0 then (
-      let i = ref i in
-      let len = ref len in
+    let i = ref i in
+    let len = ref len in
+
+    while !len > 0 do
+      let available = Cstruct.length cstruct - !offset in
+      let n = min !len available in
+      Cstruct.blit_from_bytes buf !i cstruct !offset n;
+      offset := !offset + n;
+      i := !i + n;
+      len := !len - n;
+
+      if !offset = Cstruct.length cstruct then (
+        flow#write [ cstruct ];
+        offset := 0
+      )
+    done
+  in
+  *)
+
+let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
+  (* write buffer *)
+  let wbuf = Bytes.create buf_size in
+  let offset = ref 0 in
+
+  let flush () =
+    if !offset > 0 then (
+      let i = ref 0 in
+      let len = ref !offset in
 
       let src =
         object
@@ -45,18 +85,34 @@ let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
           method read_into (cstruct : Cstruct.t) : int =
             if !len = 0 then raise End_of_file;
             let n = min !len (Cstruct.length cstruct) in
-            Cstruct.blit_from_bytes buf !i cstruct 0 n;
+            Cstruct.blit_from_bytes wbuf !i cstruct 0 n;
             i := !i + n;
             len := !len - n;
             n
         end
       in
 
-      flow#copy src
+      flow#copy src;
+      offset := 0
     )
   in
+
+  let output buf i len =
+    let i = ref i in
+    let len = ref len in
+
+    while !len > 0 do
+      let available = Bytes.length wbuf - !offset in
+      let n = min !len available in
+      Bytes.blit buf !i wbuf !offset n;
+      offset := !offset + n;
+      i := !i + n;
+      len := !len - n;
+
+      if !offset = Bytes.length wbuf then flush ()
+    done
+  in
   let close () = flow#shutdown `Send in
-  let flush () = () in
   { IO.Out_channel.close; flush; output }
 
 let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
@@ -69,13 +125,11 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
       let clock = Eio.Stdenv.clock stdenv in
       Eio.Time.now clock
 
-    let spawn f : unit =
-      Eio.Switch.run @@ fun sub_sw -> Eio.Fiber.fork ~sw:sub_sw f
-
     let tcp_server () : IO.TCP_server.builder =
       {
         IO.TCP_server.serve =
           (fun ~after_init ~handle () : unit ->
+            (* FIXME: parse *)
             let ip_addr = Eio.Net.Ipaddr.V4.any in
             let running = Atomic.make true in
             let active_conns = Atomic.make 0 in
@@ -105,8 +159,6 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
             after_init tcp_server;
 
             while Atomic.get running do
-              Eio.Switch.check sw;
-
               Eio.Net.accept_fork ~sw
                 ~on_error:(fun exn ->
                   H._debug (fun k ->

From d6402faf948f8f22f2d3990e0692086803d5e3ec Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 00:06:24 -0400
Subject: [PATCH 04/22] example: detail

---
 examples/echo_eio.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index 99013308..21185b64 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -55,7 +55,9 @@ let () =
 
   (* create server *)
   let server : S.t =
-    S_eio.create ~port:!port_ ~max_connections:!j ~stdenv ~sw ()
+    S_eio.create ~port:!port_ ~max_connections:!j
+      ~stdenv:(stdenv :> Eio.Stdenv.t)
+      ~sw ()
   in
 
   (* TODO: re-enable

From 79cbcca4c168e6dba8a056f1e0482e8bedac6f9a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 00:06:31 -0400
Subject: [PATCH 05/22] cleanup: remove unused function in
 `Tiny_httpd_server.IO_BACKEND`

---
 src/Tiny_httpd_server.ml  | 6 ------
 src/Tiny_httpd_server.mli | 5 -----
 2 files changed, 11 deletions(-)

diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml
index 24086a08..ef897fb9 100644
--- a/src/Tiny_httpd_server.ml
+++ b/src/Tiny_httpd_server.ml
@@ -631,11 +631,6 @@ module type IO_BACKEND = sig
   val init_addr : unit -> string
   val init_port : unit -> int
 
-  val spawn : (unit -> unit) -> unit
-  (** function used to spawn a new thread to handle a
-    new client connection. By default it is {!Thread.create} but one
-    could use a thread pool instead.*)
-
   val get_time_s : unit -> float
   (** obtain the current timestamp in seconds. *)
 
@@ -959,7 +954,6 @@ let create ?(masksigpipe = true) ?max_connections ?(timeout = 0.0) ?buf_size
     let init_addr () = addr
     let init_port () = port
     let get_time_s = get_time_s
-    let spawn f = new_thread f
     let tcp_server () = tcp_server_builder
   end in
   let backend = (module B : IO_BACKEND) in
diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli
index 88011f56..819fae14 100644
--- a/src/Tiny_httpd_server.mli
+++ b/src/Tiny_httpd_server.mli
@@ -406,11 +406,6 @@ module type IO_BACKEND = sig
   val init_addr : unit -> string
   val init_port : unit -> int
 
-  val spawn : (unit -> unit) -> unit
-  (** function used to spawn a new thread to handle a
-    new client connection. By default it is {!Thread.create} but one
-    could use a thread pool instead.*)
-
   val get_time_s : unit -> float
   (** obtain the current timestamp in seconds. *)
 

From 5e0a634c104358af119ca17c3fa4a371dd209862 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 00:18:37 -0400
Subject: [PATCH 06/22] tiny_httpd_eio: do not use Eio's clock for our
 internals

---
 src/eio/tiny_httpd_eio.ml | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
index 6967efc3..b6c8e681 100644
--- a/src/eio/tiny_httpd_eio.ml
+++ b/src/eio/tiny_httpd_eio.ml
@@ -120,10 +120,7 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
   let module M = struct
     let init_addr () = addr
     let init_port () = port
-
-    let get_time_s () =
-      let clock = Eio.Stdenv.clock stdenv in
-      Eio.Time.now clock
+    let get_time_s () = Unix.gettimeofday ()
 
     let tcp_server () : IO.TCP_server.builder =
       {

From 072a6041bee0c4ee1fe9e24dc136eafa8009c1d3 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 00:19:48 -0400
Subject: [PATCH 07/22] example eio: re-enable camlzip

---
 examples/echo_eio.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index 21185b64..af3848cf 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -60,8 +60,7 @@ let () =
       ~sw ()
   in
 
-  (* TODO: re-enable
-     Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server; *)
+  Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server;
   let m_stats, get_stats = middleware_stat () in
   S.add_middleware server ~stage:(`Stage 1) m_stats;
 

From 55ef988aa496d51114077d16407a7a4a00479ecf Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 21:50:55 -0400
Subject: [PATCH 08/22] details in example

---
 examples/echo_eio.ml | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index af3848cf..8c4bdb68 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -120,9 +120,15 @@ let () =
   (* stats *)
   S.add_route_handler server
     S.Route.(exact "stats" @/ return)
+      (fun _req ->
+        let stats = get_stats () in
+        S.Response.make_string @@ Ok stats);
+
+  S.add_route_handler server ~meth:`POST
+    S.Route.(exact "quit" @/ return)
     (fun _req ->
-      let stats = get_stats () in
-      S.Response.make_string @@ Ok stats);
+      S.stop server;
+      S.Response.make_string (Ok "quitting"));
 
   (* main page *)
   S.add_route_handler server
@@ -175,6 +181,14 @@ let () =
                             txt " (GET) to access a VFS embedded in the binary";
                           ];
                       ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/quit/" ] [ txt "/quit (POST)" ];
+                            txt " have the server stop";
+                          ];
+                      ];
                   ];
               ];
           ]
@@ -183,6 +197,8 @@ let () =
       S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s);
 
   Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
-  match S.run server with
+  let res = S.run server in
+  Gc.print_stat stdout;
+  match res with
   | Ok () -> ()
   | Error e -> raise e

From d2b89eee50bd5a46ec5f59c1b93b2cbcb2caed8a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 22:03:58 -0400
Subject: [PATCH 09/22] echo_eio: make `quit` into a button, to use POST

---
 examples/echo_eio.ml | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index 8c4bdb68..5318e8e5 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -120,9 +120,9 @@ let () =
   (* stats *)
   S.add_route_handler server
     S.Route.(exact "stats" @/ return)
-      (fun _req ->
-        let stats = get_stats () in
-        S.Response.make_string @@ Ok stats);
+    (fun _req ->
+      let stats = get_stats () in
+      S.Response.make_string @@ Ok stats);
 
   S.add_route_handler server ~meth:`POST
     S.Route.(exact "quit" @/ return)
@@ -183,11 +183,19 @@ let () =
                       ];
                     li []
                       [
-                        pre []
+                        pre
+                          [ A.style "display: inline" ]
                           [
-                            a [ A.href "/quit/" ] [ txt "/quit (POST)" ];
-                            txt " have the server stop";
+                            a [ A.href "/quit" ] [ txt "/quit" ];
+                            txt " (POST) to stop server";
                           ];
+                        form
+                          [
+                            A.style "display: inline";
+                            A.action "/quit";
+                            A.method_ "POST";
+                          ]
+                          [ button [ A.type_ "submit" ] [ txt "quit" ] ];
                       ];
                   ];
               ];

From 6c499584b8db75df75312164876a71c9c983d2be Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 22:18:40 -0400
Subject: [PATCH 10/22] cleanup eio

---
 src/eio/tiny_httpd_eio.ml | 27 ++++-----------------------
 1 file changed, 4 insertions(+), 23 deletions(-)

diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
index b6c8e681..698a386a 100644
--- a/src/eio/tiny_httpd_eio.ml
+++ b/src/eio/tiny_httpd_eio.ml
@@ -46,28 +46,6 @@ let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t =
   let close () = flow#shutdown `Receive in
   { IO.In_channel.input; close }
 
-(*
-
-  let output buf i len =
-    let i = ref i in
-    let len = ref len in
-
-    while !len > 0 do
-      let available = Cstruct.length cstruct - !offset in
-      let n = min !len available in
-      Cstruct.blit_from_bytes buf !i cstruct !offset n;
-      offset := !offset + n;
-      i := !i + n;
-      len := !len - n;
-
-      if !offset = Cstruct.length cstruct then (
-        flow#write [ cstruct ];
-        offset := 0
-      )
-    done
-  in
-  *)
-
 let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
   (* write buffer *)
   let wbuf = Bytes.create buf_size in
@@ -144,7 +122,10 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
             let tcp_server : IO.TCP_server.t =
               {
                 running = (fun () -> Atomic.get running);
-                stop = (fun () -> Atomic.set running false);
+                stop =
+                  (fun () ->
+                    Atomic.set running false;
+                    Eio.Switch.fail sw Exit);
                 endpoint =
                   (fun () ->
                     (* TODO: find the real port *)

From f845f1265bba6ade5fa0240216857a7dcd9540b6 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 8 Jun 2023 00:23:59 -0400
Subject: [PATCH 11/22] compat: use Eio_unix.Stdenv.base

---
 examples/echo_eio.ml       | 2 +-
 src/eio/dune               | 2 +-
 src/eio/tiny_httpd_eio.ml  | 5 +++--
 src/eio/tiny_httpd_eio.mli | 2 +-
 4 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index 5318e8e5..93deb1e9 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -56,7 +56,7 @@ let () =
   (* create server *)
   let server : S.t =
     S_eio.create ~port:!port_ ~max_connections:!j
-      ~stdenv:(stdenv :> Eio.Stdenv.t)
+      ~stdenv:(stdenv :> Eio_unix.Stdenv.base)
       ~sw ()
   in
 
diff --git a/src/eio/dune b/src/eio/dune
index 5ecf5128..37431aba 100644
--- a/src/eio/dune
+++ b/src/eio/dune
@@ -4,5 +4,5 @@
   (public_name tiny_httpd_eio)
   (synopsis "An EIO-based backend for Tiny_httpd")
   (flags :standard -safe-string -warn-error -a+8)
-  (libraries tiny_httpd eio))
+  (libraries tiny_httpd eio eio.unix))
 
diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
index 698a386a..bbcf7a9d 100644
--- a/src/eio/tiny_httpd_eio.ml
+++ b/src/eio/tiny_httpd_eio.ml
@@ -7,7 +7,7 @@ type 'a with_args =
   ?addr:string ->
   ?port:int ->
   ?max_connections:int ->
-  stdenv:Eio.Stdenv.t ->
+  stdenv:Eio_unix.Stdenv.base ->
   sw:Eio.Switch.t ->
   'a
 
@@ -94,7 +94,8 @@ let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
   { IO.Out_channel.close; flush; output }
 
 let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
-    ~(stdenv : Eio.Stdenv.t) ~(sw : Eio.Switch.t) () : (module H.IO_BACKEND) =
+    ~(stdenv : Eio_unix.Stdenv.base) ~(sw : Eio.Switch.t) () :
+    (module H.IO_BACKEND) =
   let module M = struct
     let init_addr () = addr
     let init_port () = port
diff --git a/src/eio/tiny_httpd_eio.mli b/src/eio/tiny_httpd_eio.mli
index c79f0525..487b3a84 100644
--- a/src/eio/tiny_httpd_eio.mli
+++ b/src/eio/tiny_httpd_eio.mli
@@ -4,7 +4,7 @@ type 'a with_args =
   ?addr:string ->
   ?port:int ->
   ?max_connections:int ->
-  stdenv:Eio.Stdenv.t ->
+  stdenv:Eio_unix.Stdenv.base ->
   sw:Eio.Switch.t ->
   'a
 

From 911db768649b219e6771f774705f08a95c6edab1 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 4 Jun 2023 01:33:29 -0400
Subject: [PATCH 12/22] fix CI

---
 .github/workflows/main.yml  | 14 +++++++-----
 .github/workflows/main5.yml | 45 +++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 5 deletions(-)
 create mode 100644 .github/workflows/main5.yml

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 78613ae8..4a755a59 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -13,12 +13,12 @@ jobs:
       fail-fast: true
       matrix:
         os:
-          - macos-latest
           - ubuntu-latest
-          - windows-latest
+            #- macos-latest
+            #- windows-latest
         ocaml-compiler:
-          - 4.04.x
-          - 4.14.x
+          - 4.04
+          - 4.14
 
     runs-on: ${{ matrix.os }}
 
@@ -30,9 +30,12 @@ jobs:
         uses: ocaml/setup-ocaml@v2
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          opam-local-packages: |
+            ./tiny_httpd.opam
+            ./tiny_httpd_camlzip.opam
           opam-depext-flags: --with-test
 
-      - run: opam install . --deps-only --with-test
+      - run: opam install ./tiny_httpd.opam ./tiny_httpd_camlzip.opam --deps-only --with-test
 
       - run: opam exec -- dune build @install -p tiny_httpd,tiny_httpd_camlzip
 
@@ -43,3 +46,4 @@ jobs:
 
       - run: opam exec -- dune build @src/runtest @examples/runtest @tests/runtest -p tiny_httpd_camlzip
         if: ${{ matrix.os == 'ubuntu-latest' }}
+
diff --git a/.github/workflows/main5.yml b/.github/workflows/main5.yml
new file mode 100644
index 00000000..c2632371
--- /dev/null
+++ b/.github/workflows/main5.yml
@@ -0,0 +1,45 @@
+name: build (ocaml 5)
+
+on:
+  pull_request:
+  push:
+  schedule:
+    # Prime the caches every Monday
+    - cron: 0 1 * * MON
+
+jobs:
+  build:
+    strategy:
+      fail-fast: true
+      matrix:
+        os:
+          - ubuntu-latest
+            #- macos-latest
+            #- windows-latest
+        ocaml-compiler:
+          - 5.0.x
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          opam-depext-flags: --with-test
+
+      - run: opam install . --deps-only --with-test
+
+      - run: opam exec -- dune build @install -p tiny_httpd,tiny_httpd_camlzip,tiny_httpd_eio
+
+      - run: opam exec -- dune build @src/runtest @examples/runtest @tests/runtest -p tiny_httpd
+        if: ${{ matrix.os == 'ubuntu-latest' }}
+
+      - run: opam install tiny_httpd
+
+      - run: opam exec -- dune build @src/runtest @examples/runtest @tests/runtest -p tiny_httpd_camlzip
+        if: ${{ matrix.os == 'ubuntu-latest' }}
+

From 3f3d3e34646d26d42af07cf14d03448a02218c3a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 21:57:22 -0400
Subject: [PATCH 13/22] add shims for Atomic on OCaml < 4.12

---
 src/dune           |  9 +++++++++
 src/gen/dune       |  4 ++--
 src/gen/mkshims.ml | 41 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 52 insertions(+), 2 deletions(-)
 create mode 100644 src/gen/mkshims.ml

diff --git a/src/dune b/src/dune
index cebbd305..d2d9e3db 100644
--- a/src/dune
+++ b/src/dune
@@ -18,3 +18,12 @@
   (with-stdout-to
    %{targets}
    (run %{bin}))))
+
+(rule
+ (targets Tiny_httpd_atomic_.ml)
+ (deps
+  (:bin ./gen/mkshims.exe))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run %{bin}))))
diff --git a/src/gen/dune b/src/gen/dune
index c741e9af..6cd2fd4a 100644
--- a/src/gen/dune
+++ b/src/gen/dune
@@ -1,2 +1,2 @@
-(executable
- (name gentags))
+(executables
+ (names gentags mkshims))
diff --git a/src/gen/mkshims.ml b/src/gen/mkshims.ml
new file mode 100644
index 00000000..a49f1ab7
--- /dev/null
+++ b/src/gen/mkshims.ml
@@ -0,0 +1,41 @@
+let atomic_before_412 =
+  {|
+  type 'a t = {mutable x: 'a}
+  let[@inline] make x = {x}
+  let[@inline] get {x} = x
+  let[@inline] set r x = r.x <- x
+  let[@inline] exchange r x =
+    let y = r.x in
+    r.x <- x;
+    y
+
+  let[@inline] compare_and_set r seen v =
+    if r.x == seen then (
+      r.x <- v;
+      true
+    ) else false
+
+  let[@inline] fetch_and_add r x =
+    let v = r.x in
+    r.x <- x + r.x;
+    v
+
+  let[@inline] incr r = r.x <- 1 + r.x
+  let[@inline] decr r = r.x <- r.x - 1
+  |}
+
+let atomic_after_412 = {|include Atomic|}
+
+let write_file file s =
+  let oc = open_out file in
+  output_string oc s;
+  close_out oc
+
+let () =
+  let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in
+  print_endline
+    (if version >= (4, 12) then
+      atomic_after_412
+    else
+      atomic_before_412);
+  ()

From 5ba1ff0de4d2a2de734c51f3a44fcb9a6ec1d2c5 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 22:18:13 -0400
Subject: [PATCH 14/22] add Tiny_httpd_pool

---
 src/Tiny_httpd.ml       |  1 +
 src/Tiny_httpd.mli      |  4 ++++
 src/Tiny_httpd_pool.ml  | 38 ++++++++++++++++++++++++++++++++++++++
 src/Tiny_httpd_pool.mli | 12 ++++++++++++
 4 files changed, 55 insertions(+)
 create mode 100644 src/Tiny_httpd_pool.ml
 create mode 100644 src/Tiny_httpd_pool.mli

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 5213ef34..4011fae2 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -5,3 +5,4 @@ module Util = Tiny_httpd_util
 module Dir = Tiny_httpd_dir
 module Html = Tiny_httpd_html
 module IO = Tiny_httpd_io
+module Pool = Pool
diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli
index 607d7461..be1a6f24 100644
--- a/src/Tiny_httpd.mli
+++ b/src/Tiny_httpd.mli
@@ -100,6 +100,10 @@ end
 
 module Util = Tiny_httpd_util
 
+(** {2 Resource pool} *)
+
+module Pool = Pool
+
 (** {2 Static directory serving} *)
 
 module Dir = Tiny_httpd_dir
diff --git a/src/Tiny_httpd_pool.ml b/src/Tiny_httpd_pool.ml
new file mode 100644
index 00000000..97b8e1ea
--- /dev/null
+++ b/src/Tiny_httpd_pool.ml
@@ -0,0 +1,38 @@
+module A = Tiny_httpd_atomic_
+
+type 'a list_ = Nil | Cons of int * 'a * 'a list_
+
+type 'a t = {
+  mk_item: unit -> 'a;
+  max_size: int;  (** Max number of items *)
+  items: 'a list_ A.t;
+}
+
+let create ~mk_item ?(max_size = 128) () : _ t =
+  { mk_item; max_size; items = A.make Nil }
+
+let rec acquire_ self =
+  match A.get self.items with
+  | Nil -> self.mk_item ()
+  | Cons (_, x, tl) as l ->
+    if A.compare_and_set self.items l tl then
+      x
+    else
+      acquire_ self
+
+let[@inline] size_ = function
+  | Cons (sz, _, _) -> sz
+  | Nil -> 0
+
+let rec release_ self x : unit =
+  match A.get self.items with
+  | Cons (sz, _, _) when sz >= self.max_size ->
+    (* forget the item *)
+    ()
+  | l ->
+    if not (A.compare_and_set self.items l (Cons (size_ l + 1, x, l))) then
+      release_ self x
+
+let with_resource (self : _ t) f =
+  let x = acquire_ self in
+  Fun.protect ~finally:(fun () -> release_ self x) (fun () -> f x)
diff --git a/src/Tiny_httpd_pool.mli b/src/Tiny_httpd_pool.mli
new file mode 100644
index 00000000..dd702f44
--- /dev/null
+++ b/src/Tiny_httpd_pool.mli
@@ -0,0 +1,12 @@
+(** Resource pool *)
+
+type 'a t
+(** Pool of values of type ['a] *)
+
+val create : mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
+(** Create a new pool. *)
+
+val with_resource : 'a t -> ('a -> 'b) -> 'b
+(** [with_resource pool f] runs [f x] with [x] a resource;
+    when [f] fails or returns, [x] is returned to the pool for
+    future reuse. *)

From b9faebffe450a12a2f1ba4055c385aa2d499495e Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 5 Jun 2023 23:38:02 -0400
Subject: [PATCH 15/22] use a resource pool to recycle buffers

---
 src/Tiny_httpd.ml         |  2 +-
 src/Tiny_httpd.mli        |  2 +-
 src/Tiny_httpd_pool.ml    | 26 +++++++++++++---------
 src/Tiny_httpd_pool.mli   | 10 +++++++--
 src/Tiny_httpd_server.ml  | 45 ++++++++++++++++++++++++++++-----------
 src/Tiny_httpd_server.mli |  7 ++++--
 src/eio/tiny_httpd_eio.ml | 17 +++++++++------
 7 files changed, 74 insertions(+), 35 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 4011fae2..cddbc0db 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -5,4 +5,4 @@ module Util = Tiny_httpd_util
 module Dir = Tiny_httpd_dir
 module Html = Tiny_httpd_html
 module IO = Tiny_httpd_io
-module Pool = Pool
+module Pool = Tiny_httpd_pool
diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli
index be1a6f24..1ab90cc5 100644
--- a/src/Tiny_httpd.mli
+++ b/src/Tiny_httpd.mli
@@ -102,7 +102,7 @@ module Util = Tiny_httpd_util
 
 (** {2 Resource pool} *)
 
-module Pool = Pool
+module Pool = Tiny_httpd_pool
 
 (** {2 Static directory serving} *)
 
diff --git a/src/Tiny_httpd_pool.ml b/src/Tiny_httpd_pool.ml
index 97b8e1ea..0ef45d4a 100644
--- a/src/Tiny_httpd_pool.ml
+++ b/src/Tiny_httpd_pool.ml
@@ -4,12 +4,13 @@ type 'a list_ = Nil | Cons of int * 'a * 'a list_
 
 type 'a t = {
   mk_item: unit -> 'a;
+  clear: 'a -> unit;
   max_size: int;  (** Max number of items *)
   items: 'a list_ A.t;
 }
 
-let create ~mk_item ?(max_size = 128) () : _ t =
-  { mk_item; max_size; items = A.make Nil }
+let create ?(clear = ignore) ~mk_item ?(max_size = 512) () : _ t =
+  { mk_item; clear; max_size; items = A.make Nil }
 
 let rec acquire_ self =
   match A.get self.items with
@@ -24,14 +25,19 @@ let[@inline] size_ = function
   | Cons (sz, _, _) -> sz
   | Nil -> 0
 
-let rec release_ self x : unit =
-  match A.get self.items with
-  | Cons (sz, _, _) when sz >= self.max_size ->
-    (* forget the item *)
-    ()
-  | l ->
-    if not (A.compare_and_set self.items l (Cons (size_ l + 1, x, l))) then
-      release_ self x
+let release_ self x : unit =
+  let rec loop () =
+    match A.get self.items with
+    | Cons (sz, _, _) when sz >= self.max_size ->
+      (* forget the item *)
+      ()
+    | l ->
+      if not (A.compare_and_set self.items l (Cons (size_ l + 1, x, l))) then
+        loop ()
+  in
+
+  self.clear x;
+  loop ()
 
 let with_resource (self : _ t) f =
   let x = acquire_ self in
diff --git a/src/Tiny_httpd_pool.mli b/src/Tiny_httpd_pool.mli
index dd702f44..117869ef 100644
--- a/src/Tiny_httpd_pool.mli
+++ b/src/Tiny_httpd_pool.mli
@@ -3,8 +3,14 @@
 type 'a t
 (** Pool of values of type ['a] *)
 
-val create : mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
-(** Create a new pool. *)
+val create :
+  ?clear:('a -> unit) -> mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
+(** Create a new pool.
+    @param mk_item produce a new item in case the pool is empty
+    @param max_size maximum number of item in the pool before we start
+      dropping resources on the floor. This controls resource consumption.
+    @param clear a function called on items before recycling them.
+ *)
 
 val with_resource : 'a t -> ('a -> 'b) -> 'b
 (** [with_resource pool f] runs [f x] with [x] a resource;
diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml
index ef897fb9..f4f1f07a 100644
--- a/src/Tiny_httpd_server.ml
+++ b/src/Tiny_httpd_server.ml
@@ -19,6 +19,7 @@ let _debug k =
 module Buf = Tiny_httpd_buf
 module Byte_stream = Tiny_httpd_stream
 module IO = Tiny_httpd_io
+module Pool = Tiny_httpd_pool
 
 exception Bad_req of int * string
 
@@ -325,9 +326,13 @@ module Request = struct
     | Bad_req (c, s) -> Error (c, s)
     | e -> Error (400, Printexc.to_string e)
 
-  let read_body_full ?buf_size (self : byte_stream t) : string t =
+  let read_body_full ?buf ?buf_size (self : byte_stream t) : string t =
     try
-      let buf = Buf.create ?size:buf_size () in
+      let buf =
+        match buf with
+        | Some b -> b
+        | None -> Buf.create ?size:buf_size ()
+      in
       let body = Byte_stream.read_all ~buf self.body in
       { self with body }
     with
@@ -424,12 +429,12 @@ module Response = struct
     Format.fprintf out "{@[code=%d;@ headers=[@[%a@]];@ body=%a@]}" self.code
       Headers.pp self.headers pp_body self.body
 
-  let output_ ?(buf = Buf.create ~size:256 ()) (oc : IO.Out_channel.t)
-      (self : t) : unit =
+  let output_ ~buf (oc : IO.Out_channel.t) (self : t) : unit =
     (* double indirection:
        - print into [buffer] using [bprintf]
        - transfer to [buf_] so we can output from there *)
     let tmp_buffer = Buffer.create 32 in
+    Buf.clear buf;
 
     (* write start of reply *)
     Printf.bprintf tmp_buffer "HTTP/1.1 %d %s\r\n" self.code
@@ -650,6 +655,7 @@ type t = {
   mutable path_handlers:
     (unit Request.t -> cb_path_handler resp_result option) list;
       (** path handlers *)
+  buf_pool: Buf.t Pool.t;
 }
 
 let get_addr_ sock =
@@ -741,7 +747,11 @@ let add_route_handler_ ?(accept = fun _req -> Ok ()) ?(middlewares = []) ?meth
 let add_route_handler (type a) ?accept ?middlewares ?meth self
     (route : (a, _) Route.t) (f : _) : unit =
   let tr_req _oc req ~resp f =
-    resp (f (Request.read_body_full ~buf_size:self.buf_size req))
+    let req =
+      Pool.with_resource self.buf_pool @@ fun buf ->
+      Request.read_body_full ~buf req
+    in
+    resp (f req)
   in
   add_route_handler_ ?accept ?middlewares ?meth self route ~tr_req f
 
@@ -758,7 +768,10 @@ exception Exit_SSE
 
 let add_route_server_sent_handler ?accept self route f =
   let tr_req (oc : IO.Out_channel.t) req ~resp f =
-    let req = Request.read_body_full ~buf_size:self.buf_size req in
+    let req =
+      Pool.with_resource self.buf_pool @@ fun buf ->
+      Request.read_body_full ~buf req
+    in
     let headers =
       ref Headers.(empty |> set "content-type" "text/event-stream")
     in
@@ -821,6 +834,10 @@ let create_from ?(buf_size = 16 * 1_024) ?(middlewares = []) ~backend () : t =
       path_handlers = [];
       middlewares = [];
       middlewares_sorted = lazy [];
+      buf_pool =
+        Pool.create ~clear:Buf.clear
+          ~mk_item:(fun () -> Buf.create ~size:buf_size ())
+          ();
     }
   in
   List.iter (fun (stage, m) -> add_middleware self ~stage m) middlewares;
@@ -981,7 +998,8 @@ let find_map f l =
 
 (* handle client on [ic] and [oc] *)
 let client_handle_for (self : t) ic oc : unit =
-  let buf = Buf.create ~size:self.buf_size () in
+  Pool.with_resource self.buf_pool @@ fun buf ->
+  Pool.with_resource self.buf_pool @@ fun buf_res ->
   let is = Byte_stream.of_input ~buf_size:self.buf_size ic in
   let continue = ref true in
   while !continue && running self do
@@ -992,7 +1010,7 @@ let client_handle_for (self : t) ic oc : unit =
     | Error (c, s) ->
       (* connection error, close *)
       let res = Response.make_raw ~code:c s in
-      (try Response.output_ oc res with Sys_error _ -> ());
+      (try Response.output_ ~buf:buf_res oc res with Sys_error _ -> ());
       continue := false
     | Ok (Some req) ->
       _debug (fun k -> k "req: %s" (Format.asprintf "@[%a@]" Request.pp_ req));
@@ -1007,7 +1025,8 @@ let client_handle_for (self : t) ic oc : unit =
            | None ->
              fun _oc req ~resp ->
                let body_str =
-                 Request.read_body_full ~buf_size:self.buf_size req
+                 Pool.with_resource self.buf_pool @@ fun buf ->
+                 Request.read_body_full ~buf req
                in
                resp (self.handler body_str)
          in
@@ -1016,7 +1035,7 @@ let client_handle_for (self : t) ic oc : unit =
          (match Request.get_header ~f:String.trim req "Expect" with
          | Some "100-continue" ->
            _debug (fun k -> k "send back: 100 CONTINUE");
-           Response.output_ oc (Response.make_raw ~code:100 "")
+           Response.output_ ~buf:buf_res oc (Response.make_raw ~code:100 "")
          | Some s -> bad_reqf 417 "unknown expectation %s" s
          | None -> ());
 
@@ -1041,7 +1060,7 @@ let client_handle_for (self : t) ic oc : unit =
            try
              if Headers.get "connection" r.Response.headers = Some "close" then
                continue := false;
-             Response.output_ oc r
+             Response.output_ ~buf:buf_res oc r
            with Sys_error _ -> continue := false
          in
 
@@ -1052,10 +1071,10 @@ let client_handle_for (self : t) ic oc : unit =
       (* connection broken somehow *)
       | Bad_req (code, s) ->
         continue := false;
-        Response.output_ oc @@ Response.make_raw ~code s
+        Response.output_ ~buf:buf_res oc @@ Response.make_raw ~code s
       | e ->
         continue := false;
-        Response.output_ oc
+        Response.output_ ~buf:buf_res oc
         @@ Response.fail ~code:500 "server error: %s" (Printexc.to_string e))
   done
 
diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli
index 819fae14..6a0e0157 100644
--- a/src/Tiny_httpd_server.mli
+++ b/src/Tiny_httpd_server.mli
@@ -148,10 +148,13 @@ module Request : sig
       @since 0.3
   *)
 
-  val read_body_full : ?buf_size:int -> byte_stream t -> string t
+  val read_body_full :
+    ?buf:Tiny_httpd_buf.t -> ?buf_size:int -> byte_stream t -> string t
   (** Read the whole body into a string. Potentially blocking.
 
-      @param buf_size initial size of underlying buffer (since 0.11) *)
+      @param buf_size initial size of underlying buffer (since 0.11)
+      @param buf the initial buffer (since NEXT_RELEASE)
+      *)
 
   (**/**)
 
diff --git a/src/eio/tiny_httpd_eio.ml b/src/eio/tiny_httpd_eio.ml
index bbcf7a9d..d8c89008 100644
--- a/src/eio/tiny_httpd_eio.ml
+++ b/src/eio/tiny_httpd_eio.ml
@@ -1,5 +1,6 @@
 module IO = Tiny_httpd_io
 module H = Tiny_httpd_server
+module Pool = Tiny_httpd_pool
 
 let ( let@ ) = ( @@ )
 
@@ -17,8 +18,9 @@ let get_max_connection_ ?(max_connections = 64) () : int =
 
 let buf_size = 16 * 1024
 
-let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t =
-  let cstruct = Cstruct.create buf_size in
+let ic_of_flow ~buf_pool:ic_pool (flow : Eio.Net.stream_socket) :
+    IO.In_channel.t =
+  Pool.with_resource ic_pool @@ fun cstruct ->
   let len_slice = ref 0 in
   let offset = ref 0 in
 
@@ -46,9 +48,10 @@ let ic_of_flow (flow : Eio.Net.stream_socket) : IO.In_channel.t =
   let close () = flow#shutdown `Receive in
   { IO.In_channel.input; close }
 
-let oc_of_flow (flow : Eio.Net.stream_socket) : IO.Out_channel.t =
+let oc_of_flow ~buf_pool:oc_pool (flow : Eio.Net.stream_socket) :
+    IO.Out_channel.t =
   (* write buffer *)
-  let wbuf = Bytes.create buf_size in
+  Pool.with_resource oc_pool @@ fun wbuf ->
   let offset = ref 0 in
 
   let flush () =
@@ -100,6 +103,8 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
     let init_addr () = addr
     let init_port () = port
     let get_time_s () = Unix.gettimeofday ()
+    let ic_pool = Pool.create ~mk_item:(fun () -> Cstruct.create buf_size) ()
+    let oc_pool = Pool.create ~mk_item:(fun () -> Bytes.create buf_size) ()
 
     let tcp_server () : IO.TCP_server.builder =
       {
@@ -151,8 +156,8 @@ let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
                             k "Tiny_httpd_eio: client handler returned");
                         Atomic.decr active_conns)
                   in
-                  let ic = ic_of_flow flow in
-                  let oc = oc_of_flow flow in
+                  let ic = ic_of_flow ~buf_pool:ic_pool flow in
+                  let oc = oc_of_flow ~buf_pool:oc_pool flow in
                   handle.handle ic oc)
             done);
       }

From 4138b1885a1cf581965248345d93f85091ab4844 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 20 Jun 2023 23:32:37 -0400
Subject: [PATCH 16/22] detail in makefile

---
 Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 4da8a1e6..60530672 100644
--- a/Makefile
+++ b/Makefile
@@ -15,7 +15,7 @@ clean:
 doc:
 	@dune build @doc
 
-WATCH?= "@install @runtest"
+WATCH?= @install @runtest
 watch:
 	@dune build $(OPTS) $(WATCH) -w
 

From 0adebc304b2c11731815bd133705894fed64d143 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 21 Jun 2023 11:34:42 -0400
Subject: [PATCH 17/22] fix issue for 4.04

---
 src/Tiny_httpd_pool.ml | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/Tiny_httpd_pool.ml b/src/Tiny_httpd_pool.ml
index 0ef45d4a..1a441944 100644
--- a/src/Tiny_httpd_pool.ml
+++ b/src/Tiny_httpd_pool.ml
@@ -41,4 +41,11 @@ let release_ self x : unit =
 
 let with_resource (self : _ t) f =
   let x = acquire_ self in
-  Fun.protect ~finally:(fun () -> release_ self x) (fun () -> f x)
+  try
+    let res = f x in
+    release_ self x;
+    res
+  with e ->
+    let bt = Printexc.get_raw_backtrace () in
+    release_ self x;
+    Printexc.raise_with_backtrace e bt

From 38789de89c09a181d0169d57058004dbce2c5c12 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 21 Jun 2023 12:29:05 -0400
Subject: [PATCH 18/22] require OCaml 4.05

---
 .github/workflows/main.yml | 2 +-
 tiny_httpd.opam            | 2 +-
 tiny_httpd_camlzip.opam    | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 4a755a59..49c287ce 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -17,7 +17,7 @@ jobs:
             #- macos-latest
             #- windows-latest
         ocaml-compiler:
-          - 4.04
+          - 4.05
           - 4.14
 
     runs-on: ${{ matrix.os }}
diff --git a/tiny_httpd.opam b/tiny_httpd.opam
index 083cad56..367c6d12 100644
--- a/tiny_httpd.opam
+++ b/tiny_httpd.opam
@@ -14,7 +14,7 @@ depends: [
   "base-threads"
   "result"
   "seq"
-  "ocaml" { >= "4.04.0" }
+  "ocaml" { >= "4.05.0" }
   "odoc" {with-doc}
   "conf-libcurl" {with-test}
   "qcheck-core" {with-test & >= "0.9" }
diff --git a/tiny_httpd_camlzip.opam b/tiny_httpd_camlzip.opam
index 93be4bd0..a6ca34f9 100644
--- a/tiny_httpd_camlzip.opam
+++ b/tiny_httpd_camlzip.opam
@@ -13,7 +13,7 @@ depends: [
   "dune" { >= "2.0" }
   "camlzip" {>= "1.06"}
   "tiny_httpd" { = version }
-  "ocaml" { >= "4.04.0" }
+  "ocaml" { >= "4.05.0" }
   "odoc" {with-doc}
 ]
 tags: [ "http" "thread" "server" "gzip" "camlzip" ]

From 6c8c24ea404f421cab6447eadf7fc5842ae0f111 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 23 Jun 2023 17:27:28 -0400
Subject: [PATCH 19/22] chore: opam dep

---
 tiny_httpd.opam | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tiny_httpd.opam b/tiny_httpd.opam
index 367c6d12..7409ccee 100644
--- a/tiny_httpd.opam
+++ b/tiny_httpd.opam
@@ -17,6 +17,7 @@ depends: [
   "ocaml" { >= "4.05.0" }
   "odoc" {with-doc}
   "conf-libcurl" {with-test}
+  "ptime" {with-test}
   "qcheck-core" {with-test & >= "0.9" }
   "ptime" {with-test}
 ]

From e1f0c5806529d43ef4e532cb69753e9d28b7a529 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 23 Jun 2023 17:54:43 -0400
Subject: [PATCH 20/22] echo examples: add alice endpoint; use eio_posix

---
 examples/dune        |  2 +-
 examples/echo.ml     | 34 ++++++++++++++++++++++++++++++++++
 examples/echo_eio.ml | 36 +++++++++++++++++++++++++++++++++++-
 3 files changed, 70 insertions(+), 2 deletions(-)

diff --git a/examples/dune b/examples/dune
index d01f32db..4cafb199 100644
--- a/examples/dune
+++ b/examples/dune
@@ -19,7 +19,7 @@
  (flags :standard -warn-error -a+8)
  (modules echo_eio)
  (libraries tiny_httpd tiny_httpd_camlzip
-            tiny_httpd_eio eio eio_main))
+            tiny_httpd_eio eio eio_posix))
 
 (rule
  (targets test_output.txt)
diff --git a/examples/echo.ml b/examples/echo.ml
index 6956f4d0..d00d468d 100644
--- a/examples/echo.ml
+++ b/examples/echo.ml
@@ -2,6 +2,36 @@ module S = Tiny_httpd
 
 let now_ = Unix.gettimeofday
 
+let alice_text =
+  "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of \
+   sitting by her sister on the bank, and of having nothing to do: once or \
+   twice she had peeped into the book her sister was reading, but it had no \
+   pictures or conversations in it, <and what is the use of a book,> thought \
+   Alice <without pictures or conversations?> So she was considering in her \
+   own mind (as well as she could, for the hot day made her feel very sleepy \
+   and stupid), whether the pleasure of making a daisy-chain would be worth \
+   the trouble of getting up and picking the daisies, when suddenly a White \
+   Rabbit with pink eyes ran close by her. There was nothing so very \
+   remarkable in that; nor did Alice think it so very much out of the way to \
+   hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when \
+   she thought it over afterwards, it occurred to her that she ought to have \
+   wondered at this, but at the time it all seemed quite natural); but when \
+   the Rabbit actually took a watch out of its waistcoat-pocket, and looked at \
+   it, and then hurried on, Alice started to her feet, for it flashed across \
+   her mind that she had never before seen a rabbit with either a \
+   waistcoat-pocket, or a watch to take out of it, and burning with curiosity, \
+   she ran across the field after it, and fortunately was just in time to see \
+   it pop down a large rabbit-hole under the hedge. In another moment down \
+   went Alice after it, never once considering how in the world she was to get \
+   out again. The rabbit-hole went straight on like a tunnel for some way, and \
+   then dipped suddenly down, so suddenly that Alice had not a moment to think \
+   about stopping herself before she found herself falling down a very deep \
+   well. Either the well was very deep, or she fell very slowly, for she had \
+   plenty of time as she went down to look about her and to wonder what was \
+   going to happen next. First, she tried to look down and make out what she \
+   was coming to, but it was too dark to see anything; then she looked at the \
+   sides of the well, and noticed that they were filled with cupboards......"
+
 (* util: a little middleware collecting statistics *)
 let middleware_stat () : S.Middleware.t * (unit -> string) =
   let n_req = ref 0 in
@@ -152,6 +182,10 @@ let () =
       let stats = get_stats () in
       S.Response.make_string @@ Ok stats);
 
+  S.add_route_handler server
+    S.Route.(exact "alice" @/ return)
+    (fun _req -> S.Response.make_string (Ok alice_text));
+
   (* VFS *)
   Tiny_httpd_dir.add_vfs server
     ~config:
diff --git a/examples/echo_eio.ml b/examples/echo_eio.ml
index 93deb1e9..39244a93 100644
--- a/examples/echo_eio.ml
+++ b/examples/echo_eio.ml
@@ -35,6 +35,36 @@ let middleware_stat () : S.Middleware.t * (unit -> string) =
   in
   m, get_stat
 
+let alice_text =
+  "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of \
+   sitting by her sister on the bank, and of having nothing to do: once or \
+   twice she had peeped into the book her sister was reading, but it had no \
+   pictures or conversations in it, <and what is the use of a book,> thought \
+   Alice <without pictures or conversations?> So she was considering in her \
+   own mind (as well as she could, for the hot day made her feel very sleepy \
+   and stupid), whether the pleasure of making a daisy-chain would be worth \
+   the trouble of getting up and picking the daisies, when suddenly a White \
+   Rabbit with pink eyes ran close by her. There was nothing so very \
+   remarkable in that; nor did Alice think it so very much out of the way to \
+   hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when \
+   she thought it over afterwards, it occurred to her that she ought to have \
+   wondered at this, but at the time it all seemed quite natural); but when \
+   the Rabbit actually took a watch out of its waistcoat-pocket, and looked at \
+   it, and then hurried on, Alice started to her feet, for it flashed across \
+   her mind that she had never before seen a rabbit with either a \
+   waistcoat-pocket, or a watch to take out of it, and burning with curiosity, \
+   she ran across the field after it, and fortunately was just in time to see \
+   it pop down a large rabbit-hole under the hedge. In another moment down \
+   went Alice after it, never once considering how in the world she was to get \
+   out again. The rabbit-hole went straight on like a tunnel for some way, and \
+   then dipped suddenly down, so suddenly that Alice had not a moment to think \
+   about stopping herself before she found herself falling down a very deep \
+   well. Either the well was very deep, or she fell very slowly, for she had \
+   plenty of time as she went down to look about her and to wonder what was \
+   going to happen next. First, she tried to look down and make out what she \
+   was coming to, but it was too dark to see anything; then she looked at the \
+   sides of the well, and noticed that they were filled with cupboards......"
+
 let () =
   let port_ = ref 8080 in
   let j = ref 32 in
@@ -50,7 +80,7 @@ let () =
     "echo [option]*";
 
   (* use eio *)
-  let@ stdenv = Eio_main.run in
+  let@ stdenv = Eio_posix.run in
   let@ sw = Eio.Switch.run in
 
   (* create server *)
@@ -130,6 +160,10 @@ let () =
       S.stop server;
       S.Response.make_string (Ok "quitting"));
 
+  S.add_route_handler server
+    S.Route.(exact "alice" @/ return)
+    (fun _req -> S.Response.make_string (Ok alice_text));
+
   (* main page *)
   S.add_route_handler server
     S.Route.(return)

From 9a587918fb4eb44511ababd1e26b67ae83a78f86 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 26 Jun 2023 16:04:13 -0400
Subject: [PATCH 21/22] doc

---
 src/Tiny_httpd_pool.mli | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/Tiny_httpd_pool.mli b/src/Tiny_httpd_pool.mli
index 117869ef..ab9aaa41 100644
--- a/src/Tiny_httpd_pool.mli
+++ b/src/Tiny_httpd_pool.mli
@@ -1,4 +1,11 @@
-(** Resource pool *)
+(** Resource pool.
+
+    This pool is used for buffers. It can be used for other resources
+    but do note that it assumes resources are still reasonably
+    cheap to produce and discard, and will never block waiting for
+    a resource — it's not a good pool for DB connections.
+
+    @since NEXT_RELEASE. *)
 
 type 'a t
 (** Pool of values of type ['a] *)

From bc4bce8083ee7455e4f00a44a1efa9710367cb75 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 26 Jun 2023 16:05:48 -0400
Subject: [PATCH 22/22] doc

---
 src/eio/tiny_httpd_eio.mli | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/eio/tiny_httpd_eio.mli b/src/eio/tiny_httpd_eio.mli
index 487b3a84..251f9508 100644
--- a/src/eio/tiny_httpd_eio.mli
+++ b/src/eio/tiny_httpd_eio.mli
@@ -1,3 +1,12 @@
+(** Tiny httpd EIO backend.
+
+    This replaces the threads + Unix blocking syscalls of {!Tiny_httpd_server}
+    with an Eio-based cooperative system.
+
+    {b NOTE}: this is very experimental and will absolutely change over time,
+      especially since Eio itself is also subject to change.
+    @since NEXT_RELEASE *)
+
 (* TODO: pass in a switch *)
 
 type 'a with_args =