Mehari 0.4

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.

dune-project

@@ -1,6 +1,6 @@
 (lang dune 3.0)
 
-(version 0.3)
+(version 0.4)
 
 (name mehari)
 
@@ -26,11 +26,11 @@
   (ocaml
    (>= 4.14))
   (conan
-   (>= 0.0.2))
+   (>= 0.0.5))
+  (conan-database
+   (>= 0.0.5))
   (logs
    (>= 0.7.0))
-  (magic-mime
-   (>= 1.3.0))
   (re
    (>= 1.10.4))
   (tls
@@ -89,7 +89,7 @@
   (mehari
    (= :version))
   (eio
-   (>= 0.8))
+   (>= 1.0))
   (logs
    (>= 0.7.0))
   (tls

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.

examples/cgi.ml

@@ -1,13 +1,10 @@
-module Mehari_io = Mehari_lwt_unix
-open Lwt.Infix
+module M = Mehari_lwt_unix
+open Lwt.Syntax
 
 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 ]
+  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
 
 let () = Lwt_main.run (main ())

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

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

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 ())

examples/echo.ml

@@ -1,14 +1,13 @@
-module Mehari_io = Mehari_lwt_unix
-open Lwt.Infix
+module M = Mehari_lwt_unix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  let* certchains = Common.Lwt.load_certchains () in
+  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
 
 let () = Lwt_main.run (main ())

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

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
-open Lwt.Infix
+module M = Mehari_lwt_unix
+open Lwt.Syntax
 
 let main () =
-  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
-  Mehari_io.router
+  let* certchains = Common.Lwt.load_certchains () in
+  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
 
 let () = Lwt_main.run (main ())

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 ())

examples/log.ml

@@ -1,27 +1,22 @@
-module Mehari_io = Mehari_lwt_unix
-open Lwt.Infix
+module M = Mehari_lwt_unix
+open Lwt.Syntax
 
 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
+  let* certchains = Common.Lwt.load_certchains () in
+  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
 
 let () = Lwt_main.run (main ())

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
@@ -10,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

examples/rate_limit.ml

@@ -1,18 +1,18 @@
-module Mehari_io = Mehari_lwt_unix
-open Lwt.Infix
+module M = Mehari_lwt_unix
+open Lwt.Syntax
 
-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
+  let* certchains = Common.Lwt.load_certchains () in
+  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
 
 let () = Lwt_main.run (main ())

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 () =

examples/vhost.ml

@@ -7,17 +7,14 @@ 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
 
-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

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"}