From bce9624bcb39cfc4544e31a68d449f030ce89883 Mon Sep 17 00:00:00 2001
From: Tim-ats-d <tim.arnouts@protonmail.com>
Date: Mon, 17 Jul 2023 17:09:25 +0200
Subject: [PATCH 01/14] Fix parsing of empty quote line.

---
 mehari/gemtext.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mehari/gemtext.ml b/mehari/gemtext.ml
index cc0c3cf..7803475 100644
--- a/mehari/gemtext.ml
+++ b/mehari/gemtext.ml
@@ -47,7 +47,7 @@ module Regex = struct
   let h2 = line (Re.str "##")
   let h3 = line (Re.str "###")
   let item = line (Re.str "* ")
-  let quote = Re.compile Re.(seq [ bol; Re.char '>'; group (rep1 any) ])
+  let quote = Re.compile Re.(seq [ bol; Re.char '>'; group (rep any) ])
 
   let link =
     Re.compile

From 94722bf2de579603e5c15b5d1c29a54b270528c0 Mon Sep 17 00:00:00 2001
From: Tim-ats-d <tim.arnouts@protonmail.com>
Date: Mon, 24 Jul 2023 17:51:30 +0200
Subject: [PATCH 02/14] Improve examples.

---
 examples/cgi.ml        | 11 ++++-------
 examples/echo.ml       | 12 ++++++------
 examples/guestbook.ml  | 26 ++++++++++++--------------
 examples/log.ml        | 20 ++++++++------------
 examples/proxy.ml      |  5 +++--
 examples/rate_limit.ml | 18 +++++++++---------
 examples/vhost.ml      | 14 +++++++-------
 7 files changed, 49 insertions(+), 57 deletions(-)

diff --git a/examples/cgi.ml b/examples/cgi.ml
index f4ad8b7..19b28a1 100644
--- a/examples/cgi.ml
+++ b/examples/cgi.ml
@@ -1,13 +1,10 @@
-module Mehari_io = Mehari_lwt_unix
+module M = Mehari_lwt_unix
 open Lwt.Infix
 
 let main () =
   X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
-    [
-      Mehari_io.route "/cgi" (fun req ->
-          Mehari_io.run_cgi "./examples/cgi_script.py" req);
-    ]
-  |> Mehari_io.run_lwt ~certchains:[ cert ]
+  M.router
+    [ M.route "/cgi" (fun req -> M.run_cgi "./examples/cgi_script.py" req) ]
+  |> M.run_lwt ~certchains:[ cert ]
 
 let () = Lwt_main.run (main ())
diff --git a/examples/echo.ml b/examples/echo.ml
index 1bb443d..e6ba33d 100644
--- a/examples/echo.ml
+++ b/examples/echo.ml
@@ -1,14 +1,14 @@
-module Mehari_io = Mehari_lwt_unix
+module M = Mehari_lwt_unix
 open Lwt.Infix
 
 let main () =
   X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  M.router
     [
-      Mehari_io.route ~regex:true "/echo/(.*)" (fun req ->
-          Mehari.param req 1 |> Mehari_io.respond_text);
+      M.route ~regex:true "/echo/(.*)" (fun req ->
+          Mehari.param req 1 |> M.respond_text);
     ]
-  |> Mehari_io.logger
-  |> Mehari_io.run_lwt ~certchains:[ cert ]
+  |> M.logger
+  |> M.run_lwt ~certchains:[ cert ]
 
 let () = Lwt_main.run (main ())
diff --git a/examples/guestbook.ml b/examples/guestbook.ml
index 9b5f2da..aefb362 100644
--- a/examples/guestbook.ml
+++ b/examples/guestbook.ml
@@ -3,30 +3,28 @@ let book =
     val mutable entries = []
 
     method add_entry ~addr msg =
-      entries <- (Unix.time () |> Unix.gmtime, addr, msg) :: entries
+      entries <- (Ptime_clock.now (), addr, msg) :: entries
 
     method print =
       let buf = Buffer.create 4096 in
       List.iter
-        (fun (timestamp, addr, msg) ->
+        (fun (ptime, addr, msg) ->
+          let (y, m, d), ((hh, mm, ss), _) = Ptime.to_date_time ptime in
           Format.kasprintf (Buffer.add_string buf)
-            "%i-%i-%i %i:%i:%i - %a: %s\n"
-            (timestamp.Unix.tm_year + 1900)
-            (timestamp.tm_mon + 1) timestamp.tm_mday timestamp.tm_hour
-            timestamp.tm_min timestamp.tm_sec Ipaddr.pp addr
+            "%i-%i-%i %i:%i:%i - %a: %s\n" y m d hh mm ss Ipaddr.pp addr
             (Uri.pct_decode msg))
         entries;
       Buffer.contents buf
   end
 
-module Mehari_io = Mehari_lwt_unix
+module M = Mehari_lwt_unix
 open Lwt.Infix
 
 let main () =
   X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  M.router
     [
-      Mehari_io.route "/" (fun _ ->
+      M.route "/" (fun _ ->
           Mehari.Gemtext.
             [
               heading `H1 "Guestbook";
@@ -36,14 +34,14 @@ let main () =
               heading `H2 "Entries:";
               text book#print;
             ]
-          |> Mehari_io.respond_gemtext);
-      Mehari_io.route "/submit" (fun req ->
+          |> M.respond_gemtext);
+      M.route "/submit" (fun req ->
           match Mehari.query req with
-          | None -> Mehari_io.respond Mehari.input "Enter your message"
+          | None -> M.respond Mehari.input "Enter your message"
           | Some msg ->
               book#add_entry ~addr:(Mehari.ip req) msg;
-              Mehari_io.respond Mehari.redirect_temp "/");
+              M.respond Mehari.redirect_temp "/");
     ]
-  |> Mehari_io.run_lwt ~certchains:[ cert ]
+  |> M.run_lwt ~certchains:[ cert ]
 
 let () = Lwt_main.run (main ())
diff --git a/examples/log.ml b/examples/log.ml
index e17dee5..b016412 100644
--- a/examples/log.ml
+++ b/examples/log.ml
@@ -1,27 +1,23 @@
-module Mehari_io = Mehari_lwt_unix
+module M = Mehari_lwt_unix
 open Lwt.Infix
 
 let n = ref 0
 
-let ipv4 =
-  Ipaddr.V4.of_string "192.168.1.37"
-  |> Result.get_ok |> Ipaddr.V4.Prefix.of_addr
-
 let () =
-  Mehari_io.set_log_lvl Info;
+  M.set_log_lvl Info;
   Logs.set_level (Some Info);
   Logs.set_reporter (Logs_fmt.reporter ())
 
 let main () =
   X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  M.router
     [
-      Mehari_io.route "/" (fun _ ->
+      M.route "/" (fun _ ->
           incr n;
-          Mehari_io.info (fun log -> log "Request n°: %i" !n);
-          Mehari_io.respond_text "This request is logged");
+          M.info (fun log -> log "Request n°: %i" !n);
+          M.respond_text "This request is logged");
     ]
-  |> Mehari_io.logger
-  |> Mehari_io.run_lwt ~v4:ipv4 ~certchains:[ cert ]
+  |> M.logger
+  |> M.run_lwt ~certchains:[ cert ]
 
 let () = Lwt_main.run (main ())
diff --git a/examples/proxy.ml b/examples/proxy.ml
index 68cceb7..3f071b2 100644
--- a/examples/proxy.ml
+++ b/examples/proxy.ml
@@ -1,6 +1,7 @@
-(*
+(** To test this example, run:
+{@bash[
 echo -e "gemini://foo/" | openssl s_client -crlf -connect localhost:1965 -servername foo -ign_eof
-*)
+]} *)
 
 let router =
   Mehari_eio.virtual_hosts ~meth:`ByURL
diff --git a/examples/rate_limit.ml b/examples/rate_limit.ml
index 93a3a07..bc37fa4 100644
--- a/examples/rate_limit.ml
+++ b/examples/rate_limit.ml
@@ -1,18 +1,18 @@
-module Mehari_io = Mehari_lwt_unix
+module M = Mehari_lwt_unix
 open Lwt.Infix
 
-let low_limit = Mehari_io.make_rate_limit 5 `Minute
-let high_limit = Mehari_io.make_rate_limit ~period:10 2 `Second
+let low_limit = M.make_rate_limit 5 `Minute
+let high_limit = M.make_rate_limit ~period:10 2 `Second
 
 let main () =
   X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  M.router
     [
-      Mehari_io.route "/low" ~rate_limit:low_limit (fun _ ->
-          Mehari_io.respond_text "5 requests per minute authorized");
-      Mehari_io.route "/high" ~rate_limit:high_limit (fun _ ->
-          Mehari_io.respond_text "2 requests per 10 seconds authorized");
+      M.route "/low" ~rate_limit:low_limit (fun _ ->
+          M.respond_text "5 requests per minute authorized");
+      M.route "/high" ~rate_limit:high_limit (fun _ ->
+          M.respond_text "2 requests per 10 seconds authorized");
     ]
-  |> Mehari_io.run_lwt ~certchains:[ cert ]
+  |> M.run_lwt ~certchains:[ cert ]
 
 let () = Lwt_main.run (main ())
diff --git a/examples/vhost.ml b/examples/vhost.ml
index 8eb4cb7..9073f93 100644
--- a/examples/vhost.ml
+++ b/examples/vhost.ml
@@ -7,13 +7,13 @@ let router =
 
 let main ~net ~cwd =
   let certchains =
-    Eio.Path.
-      [
-        X509_eio.private_of_pems ~cert:(cwd / "cert_foo.pem")
-          ~priv_key:(cwd / "key_foo.pem");
-        X509_eio.private_of_pems ~cert:(cwd / "cert_bar.pem")
-          ~priv_key:(cwd / "key_bar.pem");
-      ]
+    let ( / ) = Eio.Path.( / ) in
+    [
+      X509_eio.private_of_pems ~cert:(cwd / "cert_foo.pem")
+        ~priv_key:(cwd / "key_foo.pem");
+      X509_eio.private_of_pems ~cert:(cwd / "cert_bar.pem")
+        ~priv_key:(cwd / "key_bar.pem");
+    ]
   in
   Mehari_eio.run net ~certchains router
 

From a89867146294a61dfe6c4d39b4121ec7d8112333 Mon Sep 17 00:00:00 2001
From: Tim-ats-d <tim.arnouts@protonmail.com>
Date: Thu, 14 Sep 2023 21:53:40 +0200
Subject: [PATCH 03/14] Handle wildcard in certificate hostname.

---
 mehari-eio/server_impl.ml    | 11 +++++++----
 mehari-mirage/server_impl.ml | 12 ++++++++----
 mehari/mehari.mli            |  2 ++
 mehari/protocol.ml           | 33 +++++++++++++++++++--------------
 4 files changed, 36 insertions(+), 22 deletions(-)

diff --git a/mehari-eio/server_impl.ml b/mehari-eio/server_impl.ml
index 1c88f37..1de1985 100644
--- a/mehari-eio/server_impl.ml
+++ b/mehari-eio/server_impl.ml
@@ -32,11 +32,12 @@ module Make (Logger : Mehari.Private.Logger_impl.S) :
     port : int;
     timeout : (float * Eio.Time.clock) option;
     tls_config : Tls.Config.server;
+    certs : X509.Certificate.t list;
     verify_url_host : bool;
   }
 
-  let make_config ~addr ~port ~timeout ~tls_config ~verify_url_host =
-    { addr; port; timeout; tls_config; verify_url_host }
+  let make_config ~addr ~port ~timeout ~tls_config ~certs ~verify_url_host =
+    { addr; port; timeout; tls_config; certs; verify_url_host }
 
   let src = Logs.Src.create "mehari.eio"
 
@@ -80,7 +81,7 @@ module Make (Logger : Mehari.Private.Logger_impl.S) :
          |> Protocol.make_request
               (module Common.Addr)
               ~port:config.port ~addr:config.addr
-              ~verify_url_host:config.verify_url_host ep
+              ~verify_url_host:config.verify_url_host config.certs ep
        with
        | Ok req -> callback req |> write_resp flow
        | Error err -> Protocol.to_response err |> write_resp flow
@@ -124,7 +125,9 @@ module Make (Logger : Mehari.Private.Logger_impl.S) :
             ()
     in
     let config =
-      make_config ~addr ~port ~timeout ~tls_config ~verify_url_host
+      make_config ~addr ~port ~timeout ~tls_config
+        ~certs:(List.concat_map fst certchains)
+        ~verify_url_host
     in
     Eio.Switch.run (fun sw ->
         let socket =
diff --git a/mehari-mirage/server_impl.ml b/mehari-mirage/server_impl.ml
index 4517ded..2b43c70 100644
--- a/mehari-mirage/server_impl.ml
+++ b/mehari-mirage/server_impl.ml
@@ -38,11 +38,12 @@ module Make
     port : int;
     timeout : float option;
     tls_config : Tls.Config.server;
+    certs : X509.Certificate.t list;
     verify_url_host : bool;
   }
 
-  let make_config ~addr ~port ~timeout ~tls_config ~verify_url_host =
-    { addr; port; timeout; tls_config; verify_url_host }
+  let make_config ~addr ~port ~timeout ~tls_config ~certs ~verify_url_host =
+    { addr; port; timeout; tls_config; certs; verify_url_host }
 
   let src = Logs.Src.create "mehari.mirage"
 
@@ -106,7 +107,8 @@ module Make
                 Protocol.make_request
                   (module Ipaddr)
                   ~port:config.port ~addr:config.addr
-                  ~verify_url_host:config.verify_url_host ep client_req
+                  ~verify_url_host:config.verify_url_host config.certs ep
+                  client_req
               with
               | Ok req -> callback req
               | Error err -> Protocol.to_response err |> Lwt.return
@@ -152,7 +154,9 @@ module Make
             ()
     in
     let config =
-      make_config ~addr ~port ~timeout ~tls_config ~verify_url_host
+      make_config ~addr ~port ~timeout ~tls_config
+        ~certs:(List.concat_map fst certchains)
+        ~verify_url_host
     in
     Logger.info (fun log -> log "Listening on port %i" port);
     Stack.TCP.listen (Stack.tcp stack) ~port (fun flow ->
diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index 4fe0d05..a04148a 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -480,6 +480,7 @@ module Private : sig
       | MalformedUTF8
       | MissingHost
       | MissingScheme
+      | NotADomainName
       | RelativePath
       | SNIExtRequired
       | UserInfoNotAllowed
@@ -492,6 +493,7 @@ module Private : sig
       port:int ->
       addr:'a ->
       verify_url_host:bool ->
+      X509.Certificate.t list ->
       Tls.Core.epoch_data ->
       string ->
       ('a request, request_err) result
diff --git a/mehari/protocol.ml b/mehari/protocol.ml
index 9a9d517..af12268 100644
--- a/mehari/protocol.ml
+++ b/mehari/protocol.ml
@@ -6,6 +6,7 @@ type request_err =
   | MalformedUTF8
   | MissingHost
   | MissingScheme
+  | NotADomainName
   | RelativePath
   | SNIExtRequired
   | UserInfoNotAllowed
@@ -47,19 +48,22 @@ let check_user_info uri =
 let check_path uri =
   if Uri.path uri |> Filename.is_relative then Error RelativePath else Ok uri
 
-let check_host uri epoch =
+let check_host uri certs =
   match Uri.host uri with
   | None -> Error MissingHost
   | Some h -> (
-      let hostnames =
-        List.map X509.Certificate.hostnames epoch.Tls.Core.own_certificate
-        |> List.fold_left X509.Host.Set.union X509.Host.Set.empty
-        |> X509.Host.Set.to_seq
-        |> Seq.map (fun (_, d) -> Domain_name.to_string d)
-      in
-      match Seq.find (String.equal h) hostnames with
-      | None -> Error WrongHost
-      | Some _ -> Ok ())
+      match Domain_name.of_string h with
+      | Ok dn -> (
+          match Domain_name.host dn with
+          | Ok h ->
+              let rec check = function
+                | [] -> Error WrongHost
+                | c :: _ when X509.Certificate.supports_hostname c h -> Ok ()
+                | _ :: cs -> check cs
+              in
+              check certs
+          | Error _ -> Error NotADomainName)
+      | Error _ -> Error NotADomainName)
 
 let check_port uri port =
   match Uri.port uri with
@@ -71,7 +75,7 @@ let ( let+ ) x f = match x with Ok x -> f x | Error _ as err -> err
 
 (* Perform some static check on client request *)
 let make_request (type a) (module Addr : Types.ADDR with type t = a) ~port
-    ~(addr : a) ~verify_url_host epoch input =
+    ~(addr : a) ~verify_url_host certs epoch input =
   let+ sni = check_sni epoch in
   let+ () = check_utf8_encoding input in
   let+ () = check_length input in
@@ -80,7 +84,7 @@ let make_request (type a) (module Addr : Types.ADDR with type t = a) ~port
   let+ () = check_scheme uri in
   let+ () = check_user_info uri in
   let+ uri = check_path uri in
-  let+ () = if verify_url_host then check_host uri epoch else Ok () in
+  let+ () = if verify_url_host then check_host uri certs else Ok () in
   let+ () = check_port uri port in
   Request.make
     (module Addr)
@@ -98,6 +102,7 @@ let pp_err fmt =
   | MalformedUTF8 -> fmt "URL contains non-UTF8 byte sequence"
   | MissingScheme -> fmt "URL has no scheme"
   | MissingHost -> fmt "The host URL subcomponent is required"
+  | NotADomainName -> fmt "The host URL component is not a valid domain name"
   | RelativePath -> fmt "URL path is relative"
   | SNIExtRequired -> fmt "SNI extension to TLS is required"
   | UserInfoNotAllowed ->
@@ -111,8 +116,8 @@ let to_response err =
   let status =
     match err with
     | AboveMaxSize | BeginWithBOM | EmptyURL | InvalidURL | MalformedUTF8
-    | MissingHost | MissingScheme | RelativePath | SNIExtRequired
-    | UserInfoNotAllowed ->
+    | MissingHost | MissingScheme | NotADomainName | RelativePath
+    | SNIExtRequired | UserInfoNotAllowed ->
         Response.Status.bad_request
     | WrongHost | WrongPort | WrongScheme ->
         Response.Status.proxy_request_refused

From 892050915ec5210c110c7bdb3cc49e7ddec91cfd Mon Sep 17 00:00:00 2001
From: Tim-ats-d <tim.arnouts@protonmail.com>
Date: Wed, 4 Oct 2023 11:00:19 +0200
Subject: [PATCH 04/14] Opam files update.

---
 mehari-eio.opam      | 2 +-
 mehari-lwt-unix.opam | 2 +-
 mehari-mirage.opam   | 2 +-
 mehari.opam          | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/mehari-eio.opam b/mehari-eio.opam
index c13b04e..9838010 100644
--- a/mehari-eio.opam
+++ b/mehari-eio.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.2"
+version: "0.3"
 synopsis: "Mehari IO implementation using Eio"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari-lwt-unix.opam b/mehari-lwt-unix.opam
index 7eda85e..7d067be 100644
--- a/mehari-lwt-unix.opam
+++ b/mehari-lwt-unix.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.2"
+version: "0.3"
 synopsis: "Mehari IO implementation using Lwt and Unix bindings"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari-mirage.opam b/mehari-mirage.opam
index 1780b14..860b714 100644
--- a/mehari-mirage.opam
+++ b/mehari-mirage.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.2"
+version: "0.3"
 synopsis: "Mehari IO implementation for MirageOS"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari.opam b/mehari.opam
index e21c3a5..677515d 100644
--- a/mehari.opam
+++ b/mehari.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.2"
+version: "0.3"
 synopsis: "A cross-platform library for building Gemini servers"
 description: """
 Mehari is a cross-platform library for building Gemini servers.

From 7ca80a1c573683b6226433ec32281469d6aa03c2 Mon Sep 17 00:00:00 2001
From: Tim-ats-d <tim.arnouts@protonmail.com>
Date: Wed, 4 Oct 2023 11:21:15 +0200
Subject: [PATCH 05/14] Simplify example and doc.

---
 examples/README.md      |  5 +++++
 examples/cgi.ml         |  6 +++---
 examples/client_cert.ml | 13 ++-----------
 examples/common.ml      | 21 +++++++++++++++++++++
 examples/counter.ml     |  6 +++---
 examples/echo.ml        |  7 +++----
 examples/eio_backend.ml |  5 +----
 examples/guestbook.ml   |  6 +++---
 examples/hello.ml       |  7 +++----
 examples/log.ml         |  7 +++----
 examples/proxy.ml       | 13 ++-----------
 examples/rate_limit.ml  |  6 +++---
 examples/stream.ml      |  8 +-------
 examples/vhost.ml       |  5 +----
 mehari/mehari.mli       |  9 +++++----
 15 files changed, 59 insertions(+), 65 deletions(-)
 create mode 100644 examples/common.ml

diff --git a/examples/README.md b/examples/README.md
index 4c7962c..a226133 100644
--- a/examples/README.md
+++ b/examples/README.md
@@ -1,5 +1,10 @@
 # Examples
 
+In order to make examples work, you need to generate an SSL certificate in root path of the repo:
+```bash
+openssl req -x509 -newkey rsa:4096 -keyout key.pem -out cert.pem -sha256 -days 365 -nodes --subj "/CN=localhost"
+```
+
 - [hello](hello.ml) — the simplest Mehari server responds to every request with the same message.
 - [echo](echo.ml) — demonstrates how to deal with user input.
 - [counter](counter.ml) — an example of utilisation of Mehari middleware.
diff --git a/examples/cgi.ml b/examples/cgi.ml
index 19b28a1..c5b487f 100644
--- a/examples/cgi.ml
+++ b/examples/cgi.ml
@@ -1,10 +1,10 @@
 module M = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   M.router
     [ M.route "/cgi" (fun req -> M.run_cgi "./examples/cgi_script.py" req) ]
-  |> M.run_lwt ~certchains:[ cert ]
+  |> M.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/client_cert.ml b/examples/client_cert.ml
index 889cd17..a424714 100644
--- a/examples/client_cert.ml
+++ b/examples/client_cert.ml
@@ -12,16 +12,7 @@ let router =
     ]
 
 let main ~net ~cwd =
-  let certchains =
-    Eio.Path.
-      [
-        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
-          ~priv_key:(cwd / "key.pem");
-      ]
-  in
+  let certchains = Common.Eio.load_certchains cwd in
   Mehari_eio.run net ~certchains router
 
-let () =
-  Eio_main.run @@ fun env ->
-  Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
-  main ~net:env#net ~cwd:env#cwd
+let () = Common.Eio.run_server main
diff --git a/examples/common.ml b/examples/common.ml
new file mode 100644
index 0000000..05cafe8
--- /dev/null
+++ b/examples/common.ml
@@ -0,0 +1,21 @@
+open Lwt.Infix
+
+module Lwt = struct
+  let load_certchains () =
+    X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem"
+    >|= fun cert -> [ cert ]
+end
+
+module Eio = struct
+  let load_certchains cwd =
+    Eio.Path.
+      [
+        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
+          ~priv_key:(cwd / "key.pem");
+      ]
+
+  let run_server serve =
+    Eio_main.run @@ fun env ->
+    Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env
+    @@ fun () -> serve ~net:env#net ~cwd:env#cwd
+end
diff --git a/examples/counter.ml b/examples/counter.ml
index da673a9..58c9e61 100644
--- a/examples/counter.ml
+++ b/examples/counter.ml
@@ -1,5 +1,5 @@
 module Mehari_io = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let counter = ref 0
 
@@ -8,7 +8,7 @@ let incr_count handler req =
   handler req
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   Mehari_io.router
     [
       Mehari_io.route "/" (fun _ ->
@@ -21,6 +21,6 @@ let main () =
       Mehari_io.route "/incr" ~mw:incr_count (fun _ ->
           Mehari_io.respond Mehari.redirect_temp "/");
     ]
-  |> Mehari_io.run_lwt ~certchains:[ cert ]
+  |> Mehari_io.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/echo.ml b/examples/echo.ml
index e6ba33d..d9fc37b 100644
--- a/examples/echo.ml
+++ b/examples/echo.ml
@@ -1,14 +1,13 @@
 module M = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   M.router
     [
       M.route ~regex:true "/echo/(.*)" (fun req ->
           Mehari.param req 1 |> M.respond_text);
     ]
-  |> M.logger
-  |> M.run_lwt ~certchains:[ cert ]
+  |> M.logger |> M.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/eio_backend.ml b/examples/eio_backend.ml
index b67e41b..2cd7c88 100644
--- a/examples/eio_backend.ml
+++ b/examples/eio_backend.ml
@@ -16,7 +16,4 @@ let main ~net ~cwd =
   in
   Mehari_eio.run net ~certchains (router cwd)
 
-let () =
-  Eio_main.run @@ fun env ->
-  Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
-  main ~net:env#net ~cwd:env#cwd
+let () = Common.Eio.run_server main
diff --git a/examples/guestbook.ml b/examples/guestbook.ml
index aefb362..93baaab 100644
--- a/examples/guestbook.ml
+++ b/examples/guestbook.ml
@@ -18,10 +18,10 @@ let book =
   end
 
 module M = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   M.router
     [
       M.route "/" (fun _ ->
@@ -42,6 +42,6 @@ let main () =
               book#add_entry ~addr:(Mehari.ip req) msg;
               M.respond Mehari.redirect_temp "/");
     ]
-  |> M.run_lwt ~certchains:[ cert ]
+  |> M.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/hello.ml b/examples/hello.ml
index 3d3e194..80e404a 100644
--- a/examples/hello.ml
+++ b/examples/hello.ml
@@ -1,9 +1,8 @@
-open Lwt.Infix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem"
-  >>= fun certchain ->
+  let* certchains = Common.Lwt.load_certchains () in
   (fun _ -> Mehari_lwt_unix.respond_text "Hello")
-  |> Mehari_lwt_unix.run_lwt ~certchains:[ certchain ]
+  |> Mehari_lwt_unix.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/log.ml b/examples/log.ml
index b016412..6ea4d4a 100644
--- a/examples/log.ml
+++ b/examples/log.ml
@@ -1,5 +1,5 @@
 module M = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let n = ref 0
 
@@ -9,7 +9,7 @@ let () =
   Logs.set_reporter (Logs_fmt.reporter ())
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   M.router
     [
       M.route "/" (fun _ ->
@@ -17,7 +17,6 @@ let main () =
           M.info (fun log -> log "Request n°: %i" !n);
           M.respond_text "This request is logged");
     ]
-  |> M.logger
-  |> M.run_lwt ~certchains:[ cert ]
+  |> M.logger |> M.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/proxy.ml b/examples/proxy.ml
index 3f071b2..76b3d50 100644
--- a/examples/proxy.ml
+++ b/examples/proxy.ml
@@ -11,16 +11,7 @@ let router =
     ]
 
 let main ~net ~cwd =
-  let certchains =
-    Eio.Path.
-      [
-        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
-          ~priv_key:(cwd / "key.pem");
-      ]
-  in
+  let certchains = Common.Eio.load_certchains cwd in
   Mehari_eio.run net ~certchains ~verify_url_host:false router
 
-let () =
-  Eio_main.run @@ fun env ->
-  Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
-  main ~net:env#net ~cwd:env#cwd
+let () = Common.Eio.run_server main
diff --git a/examples/rate_limit.ml b/examples/rate_limit.ml
index bc37fa4..126f07e 100644
--- a/examples/rate_limit.ml
+++ b/examples/rate_limit.ml
@@ -1,11 +1,11 @@
 module M = Mehari_lwt_unix
-open Lwt.Infix
+open Lwt.Syntax
 
 let low_limit = M.make_rate_limit 5 `Minute
 let high_limit = M.make_rate_limit ~period:10 2 `Second
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
+  let* certchains = Common.Lwt.load_certchains () in
   M.router
     [
       M.route "/low" ~rate_limit:low_limit (fun _ ->
@@ -13,6 +13,6 @@ let main () =
       M.route "/high" ~rate_limit:high_limit (fun _ ->
           M.respond_text "2 requests per 10 seconds authorized");
     ]
-  |> M.run_lwt ~certchains:[ cert ]
+  |> M.run_lwt ~certchains
 
 let () = Lwt_main.run (main ())
diff --git a/examples/stream.ml b/examples/stream.ml
index 744f3c1..dceb279 100644
--- a/examples/stream.ml
+++ b/examples/stream.ml
@@ -19,13 +19,7 @@ let router clock req =
           Mehari.(response_body body plaintext))
 
 let main ~clock ~cwd ~net =
-  let certchains =
-    Eio.Path.
-      [
-        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
-          ~priv_key:(cwd / "key.pem");
-      ]
-  in
+  let certchains = Common.Eio.load_certchains cwd in
   Mehari_eio.run net ~certchains (router clock)
 
 let () =
diff --git a/examples/vhost.ml b/examples/vhost.ml
index 9073f93..eadbf0a 100644
--- a/examples/vhost.ml
+++ b/examples/vhost.ml
@@ -17,7 +17,4 @@ let main ~net ~cwd =
   in
   Mehari_eio.run net ~certchains router
 
-let () =
-  Eio_main.run @@ fun env ->
-  Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
-  main ~net:env#net ~cwd:env#cwd
+let () = Common.Eio.run_server main
diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index a04148a..3744e4a 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -22,6 +22,7 @@ type body
 
 module Gemtext : sig
   (** Implementation of the Gemini own native response format.
+
       Note that if a string containing line breaks ([CR] or [CRLF]) is given
       to functions {!val:heading}, {!val:list_item} and {!val:quote} only the
       first line will be formatted and the others treated as normal text.
@@ -83,16 +84,16 @@ val ip : 'addr request -> 'addr
 (** Address of client sending the {!type:request}. *)
 
 val port : 'a request -> int
-(** Port of client sending the {!type:request}. *)
+(** Port of requested URL. *)
 
 val sni : 'a request -> string
 (** Server name indication TLS extension. *)
 
 val query : 'a request -> string option
-(** User uri query. *)
+(** User uri query, if presents. *)
 
 val client_cert : 'a request -> X509.Certificate.t list
-(** User client certificates. *)
+(** User client certificates. [[]] if client provides none. *)
 
 val param : 'a request -> int -> string
 (** [param req n] retrieves the [n]-th path parameter of [req].
@@ -350,7 +351,7 @@ else
   val set_log_lvl : Logs.level -> unit
   (** Set Mehari's logger to the given log level. *)
 
-  val logger : clock -> handler -> handler
+  val logger : clock -> middleware
   (** Logs and times requests. Time spent logging is included. *)
 
   val debug : 'a Logs.log

From 18b5bfe832f22b88756c3c1f43ffaa481d9fe6ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 17:08:27 +0200
Subject: [PATCH 06/14] Forbide response 20 with an empty mime type.

---
 mehari-eio/file.ml      |  4 ++--
 mehari-lwt-unix/file.ml |  3 +--
 mehari/mehari.ml        |  1 -
 mehari/mehari.mli       | 12 +++++++-----
 mehari/mime.ml          | 22 +++++++++++-----------
 mehari/static.ml        |  7 +++----
 6 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/mehari-eio/file.ml b/mehari-eio/file.ml
index a049aa2..c4c2862 100644
--- a/mehari-eio/file.ml
+++ b/mehari-eio/file.ml
@@ -1,6 +1,6 @@
 let not_found = Mehari.(response not_found "")
 
-let response_document ?mime path =
+let response_document ?(mime = Mehari.app_octet_stream) path =
   try
     let chunk_size = 16384 in
     let body =
@@ -24,7 +24,7 @@ let response_document ?mime path =
               in
               loop ()))
     in
-    Option.value mime ~default:Mehari.no_mime |> Mehari.response_body body
+    Mehari.response_body body mime
   with Eio.Io _ -> not_found
 
 include
diff --git a/mehari-lwt-unix/file.ml b/mehari-lwt-unix/file.ml
index 1e1fcdb..c8e5109 100644
--- a/mehari-lwt-unix/file.ml
+++ b/mehari-lwt-unix/file.ml
@@ -89,10 +89,9 @@ let read_chunks path =
 
 let not_found = Mehari_io.respond Mehari.not_found ""
 
-let respond_document ?mime path =
+let respond_document ?(mime = Mehari.app_octet_stream) path =
   let* exists = Lwt_unix.file_exists path in
   if exists then
-    let mime = Option.value mime ~default:Mehari.no_mime in
     let* chunks = read_chunks path in
     let* cs = chunks () in
     Mehari_io.respond_body (Mehari.seq (fun () -> cs)) mime
diff --git a/mehari/mehari.ml b/mehari/mehari.ml
index 8f06dab..359a44b 100644
--- a/mehari/mehari.ml
+++ b/mehari/mehari.ml
@@ -32,7 +32,6 @@ let page = Response.page
 let make_mime = Mime.make_mime
 let from_filename = Mime.from_filename
 let from_content = Mime.from_content
-let no_mime = Mime.no_mime
 let gemini = Mime.gemini
 let app_octet_stream = Mime.app_octet_stream
 let plaintext = Mime.plaintext
diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index 4fe0d05..8649a6b 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -205,6 +205,8 @@ val make_mime : ?charset:string -> string -> mime
     [charset]. Charset defaults to [utf-8] if mime type begins with
     [text/].
 
+    @raise Invalid_argument if [mime] is an empty string
+
     @see < https://www.rfc-editor.org/rfc/rfc2046#section-4.1.2 >
       For a description of the "charset" parameter. *)
 
@@ -220,9 +222,6 @@ val from_content : ?charset:string -> tree:Conan.Tree.t -> string -> mime option
     performing a mime lookup based on content [c]. [tree] is the tree used to
     build the MIME database. *)
 
-val no_mime : mime
-(** Represents the absence of a mime. This is a shortcut for [make_mime ""]. *)
-
 val gemini : ?charset:string -> ?lang:string list -> unit -> mime
 (** [gemini ?charset ?lang ()] is [text/gemini; charset=...; lang=...].
 
@@ -373,8 +372,8 @@ module type FS = sig
   (** Same as {!val:Mehari.response} but respond with content of given
       [filename] and use given {!type:Mehari.mime} as mime type.
       If [filename] is not present on filesystem, responds with
-      {!val:Mehari.not_found}. If [mime] parameter is not supplied, use
-      {!val:Mehari.no_mime} as mime type. *)
+      {!val:Mehari.not_found}. If [mime] parameter is not supplied, document is
+      served as {!val:Mehari.app_octet_stream}. *)
 
   val static :
     ?handler:(dir_path -> handler) ->
@@ -399,6 +398,9 @@ module type FS = sig
   will be generated by calling [dir_listing [ filename; ... ] request].
   [index] is default on [index.gmi].
 
+  Mime type of the served ressource is guessed by checking file name.
+  Note that file names of the form [*.gmi] will be served as [text/gemini].
+
   [show_hidden] decides whether hidden files should be listed. It defaults to
   [false] for security reasons. *)
 end
diff --git a/mehari/mime.ml b/mehari/mime.ml
index 67a6c38..6f41cf3 100644
--- a/mehari/mime.ml
+++ b/mehari/mime.ml
@@ -1,16 +1,16 @@
 type t = { mime : string; charset : string option; lang : string list }
 
-let make_mime ?charset mime =
-  {
-    mime;
-    charset =
-      (match charset with
-      | None when String.starts_with ~prefix:"text/" mime -> Some "utf-8"
-      | _ -> None);
-    lang = [];
-  }
-
-let no_mime = make_mime ""
+let make_mime ?charset = function
+  | "" -> raise (Invalid_argument "Mehari.make_mime")
+  | mime ->
+      {
+        mime;
+        charset =
+          (match charset with
+          | None when String.starts_with ~prefix:"text/" mime -> Some "utf-8"
+          | _ -> None);
+        lang = [];
+      }
 
 let gemini ?charset ?(lang = []) () =
   { (make_mime ?charset "text/gemini") with lang }
diff --git a/mehari/static.ml b/mehari/static.ml
index 5a666d8..3e3a5c1 100644
--- a/mehari/static.ml
+++ b/mehari/static.ml
@@ -50,11 +50,10 @@ module Make (Dir : DIR) (Addr : Types.T) :
     let fname = Request.param req 1 in
     let mime =
       match Mime.from_filename fname with
-      | None when Filename.check_suffix fname ".gmi" -> Mime.gemini ()
-      | None -> Mime.no_mime
-      | Some m -> m
+      | None when Filename.check_suffix fname ".gmi" -> Some (Mime.gemini ())
+      | (None | Some _) as m -> m
     in
-    Dir.response_document ~mime path
+    Dir.response_document ?mime path
 
   let parent_path =
     Re.(compile (seq [ Re.group (seq [ rep1 any; char '/' ]); rep1 any ]))

From 35b2fa784743520a5dd80d97ee1c1e374b9822be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 17:21:01 +0200
Subject: [PATCH 07/14] Change definition of 44 status code.

---
 mehari/mehari.mli           | 2 +-
 mehari/rate_limiter_impl.ml | 3 ++-
 mehari/response.ml          | 4 +---
 3 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index 3df88f0..7b4e0f6 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -145,7 +145,7 @@ val temporary_failure : string status
 val server_unavailable : string status
 val cgi_error : string status
 val proxy_error : string status
-val slow_down : int status
+val slow_down : string status
 val perm_failure : string status
 val not_found : string status
 val gone : string status
diff --git a/mehari/rate_limiter_impl.ml b/mehari/rate_limiter_impl.ml
index b269969..d99be2e 100644
--- a/mehari/rate_limiter_impl.ml
+++ b/mehari/rate_limiter_impl.ml
@@ -43,7 +43,8 @@ module Make (Clock : Types.PCLOCK) (IO : Types.IO) (Addr : Types.ADDR) :
     let n = AddrMap.find_opt addr t.history |> Option.fold ~none:1 ~some:succ in
     t.history <- AddrMap.add addr n t.history;
     if n > t.requests then
-      Response.(response Status.slow_down time_left) |> IO.return |> Option.some
+      Response.(response Status.slow_down "Rate limited")
+      |> IO.return |> Option.some
     else None
 
   let make clock ?(period = 1) requests duration =
diff --git a/mehari/response.ml b/mehari/response.ml
index 54d989e..115191d 100644
--- a/mehari/response.ml
+++ b/mehari/response.ml
@@ -13,7 +13,6 @@ type 'a status = int * 'a typ
 
 and _ typ =
   | Success : body -> Mime.t typ
-  | SlowDown : int typ
   | Meta : string typ
 
 and body = String of string | Gemtext of Gemtext.t | Stream of stream
@@ -70,7 +69,6 @@ let to_response (type a) ((code, status) : a status) (m : a) =
   let meta, body =
     match status with
     | Success body -> (Mime.to_string m, Some body)
-    | SlowDown -> (Int.to_string m, None)
     | Meta -> (m, None)
   in
   { status = Some code; kind = validate code meta body }
@@ -85,7 +83,7 @@ module Status = struct
   let server_unavailable = (41, Meta)
   let cgi_error = (42, Meta)
   let proxy_error = (43, Meta)
-  let slow_down = (44, SlowDown)
+  let slow_down = (44, Meta)
   let perm_failure = (50, Meta)
   let not_found = (51, Meta)
   let gone = (52, Meta)

From 65690252bd89cf14f7d4ef7244eb950dfc5013c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 18:14:31 +0200
Subject: [PATCH 08/14] Drop `magic-mime` dependance.

---
 dune-project   | 4 +---
 mehari.opam    | 3 +--
 mehari/dune    | 2 +-
 mehari/mime.ml | 7 ++++---
 4 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/dune-project b/dune-project
index 165948c..0ef18ce 100644
--- a/dune-project
+++ b/dune-project
@@ -26,11 +26,9 @@
   (ocaml
    (>= 4.14))
   (conan
-   (>= 0.0.2))
+   (>= 0.0.5))
   (logs
    (>= 0.7.0))
-  (magic-mime
-   (>= 1.3.0))
   (re
    (>= 1.10.4))
   (tls
diff --git a/mehari.opam b/mehari.opam
index 677515d..5dd967e 100644
--- a/mehari.opam
+++ b/mehari.opam
@@ -14,9 +14,8 @@ bug-reports: "https://github.com/Psi-Prod/Mehari/issues"
 depends: [
   "dune" {>= "3.0"}
   "ocaml" {>= "4.14"}
-  "conan" {>= "0.0.2"}
+  "conan" {>= "0.0.5"}
   "logs" {>= "0.7.0"}
-  "magic-mime" {>= "1.3.0"}
   "re" {>= "1.10.4"}
   "tls" {>= "0.16.0"}
   "uri" {>= "4.2.0"}
diff --git a/mehari/dune b/mehari/dune
index fa2e666..280a922 100644
--- a/mehari/dune
+++ b/mehari/dune
@@ -1,7 +1,7 @@
 (library
  (name mehari)
  (public_name mehari)
- (libraries conan.string logs magic-mime tls uri x509))
+ (libraries conan.string conan-database.bindings logs tls uri x509))
 
 (documentation
  (package mehari))
diff --git a/mehari/mime.ml b/mehari/mime.ml
index 6f41cf3..09e8a00 100644
--- a/mehari/mime.ml
+++ b/mehari/mime.ml
@@ -21,9 +21,10 @@ let plaintext = text "plain"
 let with_charset t c = { t with charset = Some c }
 
 let from_filename ?charset fname =
-  match Magic_mime.lookup ~default:"" fname with
-  | "" -> None
-  | mime -> make_mime mime ~charset |> Option.some
+  match Conan_bindings.Extensions.(Map.find_opt fname map) with
+  | None -> None
+  | Some [] -> assert false
+  | Some (m :: _) -> make_mime m ~charset |> Option.some
 
 let from_content ?charset ~tree content =
   match Conan_string.run ~database:(Conan.Process.database ~tree) content with

From 52923f75e5b408d05f878480fe328acfab2a4176 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 18:40:35 +0200
Subject: [PATCH 09/14] Fix documentation.

---
 README.md         | 2 +-
 mehari/index.mld  | 6 +++---
 mehari/mehari.mli | 8 ++++----
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/README.md b/README.md
index 598eeac..87aa1af 100644
--- a/README.md
+++ b/README.md
@@ -2,7 +2,7 @@
 
 Mehari is a cross-platform library for building Gemini servers. It fully
 implements the
-[Gemini protocol specification](https://gemini.circumlunar.space/docs/specification.gmi).
+[Gemini protocol specification](https://geminiprotocol.net/docs/protocol-specification.gmi).
 
 It takes heavy inspiration from [Dream](https://github.com/aantron/dream), a
 tidy, feature-complete Web framework.
diff --git a/mehari/index.mld b/mehari/index.mld
index aff6ca2..42e2855 100644
--- a/mehari/index.mld
+++ b/mehari/index.mld
@@ -2,7 +2,7 @@
 
 Mehari is a cross-platform library for building Gemini servers. It fully
 implements the
-{{:https://gemini.circumlunar.space/docs/specification.gmi} Gemini protocol specification}.
+{{:https://geminiprotocol.net/docs/protocol-specification.gmi} Gemini protocol specification}.
 It offers a simple and clean interface to create complete Gemini web apps.
 It takes heavy inspiration from {{:https://github.com/aantron/dream} Dream}, a
 tidy, feature-complete Web framework.
@@ -159,7 +159,7 @@ Some common MIME type are predefined. See {!Mehari.section-"mime"} section.
 
 The [text/gemini] MIME type allows an additional parameter [lang] to specify
 the languages used in the document according to the
-{{:https://gemini.circumlunar.space/docs/specification.gmi} Gemini specification}:
+{{:https://geminiprotocol.net/docs/protocol-specification.gmi} Gemini specification}:
 
 {@ocaml[
 let french_ascii_gemini = Mehari.gemini ~charset:"ascii" ~lang:["fr"] ()
@@ -243,7 +243,7 @@ let router =
 This road is limited to 3 accesses every 5 minutes:
 
 {@ocaml[
-let limit = Mehari_eio.make_rate_limit 5 `Minute
+let limit = Mehari_eio.make_rate_limit ~period:3 5 `Minute
 
 let limited_route = Mehari_eio.route "/stats" ~rate_limit:limit (fun _ -> ...)
 ]}
diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index 7b4e0f6..13d05de 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -21,7 +21,8 @@ type body
 (** {1:gemtext Gemtext} *)
 
 module Gemtext : sig
-  (** Implementation of the Gemini own native response format.
+  (** Implementation of {{:https://geminiprotocol.net/docs/gemtext-specification.gmi}Gemtext},
+      the Gemini own native response format.
 
       Note that if a string containing line breaks ([CR] or [CRLF]) is given
       to functions {!val:heading}, {!val:list_item} and {!val:quote} only the
@@ -132,9 +133,8 @@ val response_raw :
 (** {1:status Status} *)
 
 (** A wrapper around Gemini status codes.
-    @see < https://gemini.circumlunar.space/docs/specification.gmi >
-      Section "Appendix 1. Full two digit status codes" for a description of
-      the meaning of each code. *)
+    @see < https://geminiprotocol.net/docs/protocol-specification.gmi >
+      Section "Status codes" for a description of the meaning of each code. *)
 
 val input : string status
 val sensitive_input : string status

From fc4e546d5e010e3a2ccb0fa73b729b8f14df611d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 18:58:39 +0200
Subject: [PATCH 10/14] Use buffer instead of Format module in output Gemtext
 functions.

---
 mehari/gemtext.ml | 30 ++++++++++++++++--------------
 mehari/mehari.mli |  4 ++++
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/mehari/gemtext.ml b/mehari/gemtext.ml
index 7803475..7ed8ec0 100644
--- a/mehari/gemtext.ml
+++ b/mehari/gemtext.ml
@@ -18,24 +18,26 @@ let heading h text = Heading (h, text)
 let list_item text = ListItem text
 let quote text = Quote text
 
-let pp_line ppf =
-  let open Format in
-  function
-  | Text t -> pp_print_string ppf t
+let line_to_string = function
+  | Text t -> t
   | Link { url; name } ->
-      fprintf ppf "=> %s%a" url (pp_print_option (Fun.flip fprintf " %s")) name
+      Printf.sprintf "=> %s%s" url
+        (Option.fold ~none:"" ~some:(Printf.sprintf " %s") name)
   | Preformat { alt; text } ->
-      fprintf ppf "```%a@\n%s@\n```" (pp_print_option pp_print_string) alt text
-  | Heading (`H1, t) -> fprintf ppf "# %s" t
-  | Heading (`H2, t) -> fprintf ppf "## %s" t
-  | Heading (`H3, t) -> fprintf ppf "### %s" t
-  | ListItem t -> fprintf ppf "* %s" t
-  | Quote t -> fprintf ppf ">%s" t
+      Printf.sprintf "```%s\n%s\n```" (Option.value ~default:"" alt) text
+  | Heading (`H1, t) -> Printf.sprintf "# %s" t
+  | Heading (`H2, t) -> Printf.sprintf "## %s" t
+  | Heading (`H3, t) -> Printf.sprintf "### %s" t
+  | ListItem t -> Printf.sprintf "* %s" t
+  | Quote t -> Printf.sprintf ">%s" t
 
-let pp ppf t =
-  Format.pp_print_list ~pp_sep:Format.pp_force_newline pp_line ppf t
+let to_string t =
+  let buf = Buffer.create 1024 in
+  List.iter (fun line -> Buffer.add_string buf (line_to_string line)) t;
+  Buffer.contents buf
 
-let to_string t = Format.asprintf "%a" pp t
+let pp_line ppf line = Format.pp_print_string ppf (line_to_string line)
+let pp ppf t = Format.pp_print_string ppf (to_string t)
 
 module Regex = struct
   let spaces = Re.(rep (alt [ char ' '; char '\t' ]))
diff --git a/mehari/mehari.mli b/mehari/mehari.mli
index 13d05de..765370e 100644
--- a/mehari/mehari.mli
+++ b/mehari/mehari.mli
@@ -46,6 +46,8 @@ let () = assert ([ quote "hello\nworld" ] = [ quote "hello"; text "world" ])
 
   and preformat = { alt : string option; text : string }
 
+  val line_to_string : line -> string
+
   val of_string : string -> t
   val to_string : t -> string
 
@@ -61,6 +63,8 @@ let () = assert ([ quote "hello\nworld" ] = [ quote "hello"; text "world" ])
   val heading : [ `H1 | `H2 | `H3 ] -> string -> line
   val list_item : string -> line
   val quote : string -> line
+
+  val pp_line : Format.formatter -> line -> unit
   val pp : Format.formatter -> t -> unit
 end
 

From 0ebeaeb99ccc246b4a532b7d182bf6230b1a751c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 28 May 2024 20:20:59 +0200
Subject: [PATCH 11/14] Make Mehari_eio compile.

---
 mehari-eio/file.ml        |  9 ++++-----
 mehari-eio/mehari_eio.ml  | 15 ++++++++-------
 mehari-eio/mehari_eio.mli |  8 ++++----
 mehari-eio/server_impl.ml |  8 ++++----
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/mehari-eio/file.ml b/mehari-eio/file.ml
index c4c2862..bd60a4a 100644
--- a/mehari-eio/file.ml
+++ b/mehari-eio/file.ml
@@ -32,13 +32,12 @@ include
     (struct
       module IO = Common.Direct
 
-      type path = Eio.Fs.dir Eio.Path.t
+      type path = [ `Dir ] Eio.Path.t
 
       let kind path =
-        Eio.Path.with_open_in path (fun flow ->
-            match flow#stat.kind with
-            | (`Regular_file | `Directory) as f -> f
-            | _ -> `Other)
+        match (Eio.Path.stat ~follow:true path).kind with
+        | (`Regular_file | `Directory) as f -> f
+        | _ -> `Other
 
       let exists _ = true
       let read = Eio.Path.read_dir
diff --git a/mehari-eio/mehari_eio.ml b/mehari-eio/mehari_eio.ml
index 56ff978..19a5510 100644
--- a/mehari-eio/mehari_eio.ml
+++ b/mehari-eio/mehari_eio.ml
@@ -2,20 +2,15 @@ module Addr = Common.Addr
 module Direct = Common.Direct
 module IO = Common.Direct
 
-module type S =
-  Mehari.NET
-    with module IO := Direct
-     and type addr = Eio.Net.Ipaddr.v4v6
-     and type clock := Eio.Time.clock
 
 module Clock = struct
-  type t = Eio.Time.clock
+  type t = [ `Clock of float ] Eio.Time.clock
 
   (* Taken from mirage-clock-unix https://github.com/mirage/mirage-clock/blob/main/unix/pclock.ml#L17 *)
   let ps_count_in_s = 1_000_000_000_000L
 
   let now_d_ps clock =
-    let ns, secs = clock#now |> Float.modf in
+    let ns, secs = Eio.Time.now clock |> Float.modf in
     let ns = Int64.of_float (ns *. 1000.) in
     let secs = Int64.of_float secs in
     let days = Int64.div secs 86_400L in
@@ -25,6 +20,12 @@ module Clock = struct
     (Int64.to_int days, Int64.add rem_ps frac_ps)
 end
 
+module type S =
+  Mehari.NET
+    with module IO := Direct
+     and type addr = Eio.Net.Ipaddr.v4v6
+     and type clock = Clock.t
+
 module RateLimiter =
   Mehari.Private.Rate_limiter_impl.Make (Clock) (Direct) (Addr)
 
diff --git a/mehari-eio/mehari_eio.mli b/mehari-eio/mehari_eio.mli
index 2952a5f..ee20113 100644
--- a/mehari-eio/mehari_eio.mli
+++ b/mehari-eio/mehari_eio.mli
@@ -10,14 +10,14 @@ include
   Mehari.NET
     with module IO := Direct
      and type addr = Addr.t
-     and type clock := Eio.Time.clock
+     and type clock := [ `Clock of float ] Eio.Time.clock
 
 (** @closed *)
 include
   Mehari.FS
     with module IO := Direct
      and type addr = Addr.t
-     and type dir_path := Eio.Fs.dir Eio.Path.t
+     and type dir_path := [ `Dir ] Eio.Path.t
 
 (** {1 Entry point} *)
 
@@ -25,11 +25,11 @@ val run :
   ?port:int ->
   ?verify_url_host:bool ->
   ?config:Tls.Config.server ->
-  ?timeout:float * Eio.Time.clock ->
+  ?timeout:float * [ `Clock of float ] Eio.Time.clock ->
   ?backlog:int ->
   ?addr:addr ->
   certchains:Tls.Config.certchain list ->
-  Eio.Net.t ->
+  _ Eio.Net.t ->
   handler ->
   unit
 (** [run ?port ?verify_url_host ?config ?backlog ?addr certchains net handler] runs the server
diff --git a/mehari-eio/server_impl.ml b/mehari-eio/server_impl.ml
index 1de1985..0a33a9e 100644
--- a/mehari-eio/server_impl.ml
+++ b/mehari-eio/server_impl.ml
@@ -7,11 +7,11 @@ module type S = sig
     ?port:int ->
     ?verify_url_host:bool ->
     ?config:Tls.Config.server ->
-    ?timeout:float * Eio.Time.clock ->
+    ?timeout:float * [ `Clock of float ] Eio.Time.clock ->
     ?backlog:int ->
     ?addr:Eio.Net.Ipaddr.v4v6 ->
     certchains:Tls.Config.certchain list ->
-    Eio.Net.t ->
+    _ Eio.Net.t ->
     handler ->
     unit
 end
@@ -30,7 +30,7 @@ module Make (Logger : Mehari.Private.Logger_impl.S) :
   type config = {
     addr : Net.Ipaddr.v4v6;
     port : int;
-    timeout : (float * Eio.Time.clock) option;
+    timeout : (float * [ `Clock of float ] Eio.Time.clock) option;
     tls_config : Tls.Config.server;
     certs : X509.Certificate.t list;
     verify_url_host : bool;
@@ -92,7 +92,7 @@ module Make (Logger : Mehari.Private.Logger_impl.S) :
     | Failure _ -> Protocol.to_response InvalidURL |> write_resp flow
     | Eio.Time.Timeout ->
         Log.warn (fun log -> log "Timeout while reading client request"));
-    flow#shutdown `Send
+    Eio.Flow.shutdown flow `Send
 
   let handler ~config callback flow _ =
     let server = Tls_eio.server_of_flow config.tls_config flow in

From b493af280c6d0815aad6115516905c0f2259ef2a Mon Sep 17 00:00:00 2001
From: ArtichautCosmique <lelolartichaut@laposte.net>
Date: Tue, 4 Jun 2024 21:41:50 +0200
Subject: [PATCH 12/14] Add conan-database to deps.

---
 dune-project | 2 ++
 mehari.opam  | 1 +
 2 files changed, 3 insertions(+)

diff --git a/dune-project b/dune-project
index 0ef18ce..3b323b2 100644
--- a/dune-project
+++ b/dune-project
@@ -27,6 +27,8 @@
    (>= 4.14))
   (conan
    (>= 0.0.5))
+  (conan-database
+   (>= 0.0.5))
   (logs
    (>= 0.7.0))
   (re
diff --git a/mehari.opam b/mehari.opam
index 5dd967e..88ea24b 100644
--- a/mehari.opam
+++ b/mehari.opam
@@ -15,6 +15,7 @@ depends: [
   "dune" {>= "3.0"}
   "ocaml" {>= "4.14"}
   "conan" {>= "0.0.5"}
+  "conan-database" {>= "0.0.5"}
   "logs" {>= "0.7.0"}
   "re" {>= "1.10.4"}
   "tls" {>= "0.16.0"}

From 610687a71b273886f88362818c0450376aa4a37e Mon Sep 17 00:00:00 2001
From: ArtichautCosmique <lelolartichaut@laposte.net>
Date: Tue, 4 Jun 2024 21:42:27 +0200
Subject: [PATCH 13/14] Bump version to 0.4.

---
 dune-project         | 2 +-
 mehari-eio.opam      | 2 +-
 mehari-lwt-unix.opam | 2 +-
 mehari-mirage.opam   | 2 +-
 mehari.opam          | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/dune-project b/dune-project
index 3b323b2..5040a2d 100644
--- a/dune-project
+++ b/dune-project
@@ -1,6 +1,6 @@
 (lang dune 3.0)
 
-(version 0.3)
+(version 0.4)
 
 (name mehari)
 
diff --git a/mehari-eio.opam b/mehari-eio.opam
index 9838010..a0eab49 100644
--- a/mehari-eio.opam
+++ b/mehari-eio.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation using Eio"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari-lwt-unix.opam b/mehari-lwt-unix.opam
index 7d067be..c0504c5 100644
--- a/mehari-lwt-unix.opam
+++ b/mehari-lwt-unix.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation using Lwt and Unix bindings"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari-mirage.opam b/mehari-mirage.opam
index 860b714..c045c76 100644
--- a/mehari-mirage.opam
+++ b/mehari-mirage.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation for MirageOS"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari.opam b/mehari.opam
index 88ea24b..8961af6 100644
--- a/mehari.opam
+++ b/mehari.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "A cross-platform library for building Gemini servers"
 description: """
 Mehari is a cross-platform library for building Gemini servers.

From 9b397435e85f814a5b721f3be398858e3e102797 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= <tim.arnouts@protonmail.com>
Date: Tue, 4 Jun 2024 23:07:54 +0200
Subject: [PATCH 14/14] Mehari 0.4

---
 dune-project         | 4 ++--
 mehari-eio.opam      | 4 ++--
 mehari-lwt-unix.opam | 2 +-
 mehari-mirage.opam   | 2 +-
 mehari.opam          | 2 +-
 mehari/index.mld     | 2 +-
 mehari/static.ml     | 6 +++---
 7 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/dune-project b/dune-project
index 0ef18ce..9238528 100644
--- a/dune-project
+++ b/dune-project
@@ -1,6 +1,6 @@
 (lang dune 3.0)
 
-(version 0.3)
+(version 0.4)
 
 (name mehari)
 
@@ -87,7 +87,7 @@
   (mehari
    (= :version))
   (eio
-   (>= 0.8))
+   (>= 1.0))
   (logs
    (>= 0.7.0))
   (tls
diff --git a/mehari-eio.opam b/mehari-eio.opam
index 9838010..1d81eb5 100644
--- a/mehari-eio.opam
+++ b/mehari-eio.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation using Eio"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
@@ -11,7 +11,7 @@ depends: [
   "dune" {>= "3.0"}
   "ocaml" {>= "5.0.0"}
   "mehari" {= version}
-  "eio" {>= "0.8"}
+  "eio" {>= "1.0"}
   "logs" {>= "0.7.0"}
   "tls" {>= "0.15.4"}
   "tls-eio" {>= "0.15.5"}
diff --git a/mehari-lwt-unix.opam b/mehari-lwt-unix.opam
index 7d067be..c0504c5 100644
--- a/mehari-lwt-unix.opam
+++ b/mehari-lwt-unix.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation using Lwt and Unix bindings"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari-mirage.opam b/mehari-mirage.opam
index 860b714..c045c76 100644
--- a/mehari-mirage.opam
+++ b/mehari-mirage.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "Mehari IO implementation for MirageOS"
 maintainer: ["tim.arnouts@protonmail.com" "lelolartichaut@laposte.net"]
 authors: ["The mehari programmers"]
diff --git a/mehari.opam b/mehari.opam
index 5dd967e..a581dbe 100644
--- a/mehari.opam
+++ b/mehari.opam
@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3"
+version: "0.4"
 synopsis: "A cross-platform library for building Gemini servers"
 description: """
 Mehari is a cross-platform library for building Gemini servers.
diff --git a/mehari/index.mld b/mehari/index.mld
index 42e2855..4ac1871 100644
--- a/mehari/index.mld
+++ b/mehari/index.mld
@@ -29,7 +29,7 @@ Mehari provides several packages:
     CGI.
 
   - {{:../mehari-eio/index.html} Mehari_eio} uses the
-    {{:https://github.com/ocaml-multicore/eio} Eio} OCaml 5.0 library.
+    {{:https://github.com/ocaml-multicore/eio} Eio} OCaml 5.0+ library.
 
 {2 Implementation choice}
 
diff --git a/mehari/static.ml b/mehari/static.ml
index 3e3a5c1..97457b4 100644
--- a/mehari/static.ml
+++ b/mehari/static.ml
@@ -42,9 +42,9 @@ module Make (Dir : DIR) (Addr : Types.T) :
   let ( let* ) = Dir.IO.bind
 
   let pp_kind fmt = function
-    | `Regular_file -> Format.fprintf fmt "\u{1F4C4}"
-    | `Directory -> Format.fprintf fmt "\u{1F4C1}"
-    | `Other -> Format.fprintf fmt "\u{2753}"
+    | `Regular_file -> Format.pp_print_string fmt "\u{1F4C4}"
+    | `Directory -> Format.pp_print_string fmt "\u{1F4C1}"
+    | `Other -> Format.pp_print_string fmt "\u{2753}"
 
   let default_handler path req =
     let fname = Request.param req 1 in