Merge pull request #63 from Psi-Prod/dev

Mehari 0.2

.gitignore

@@ -30,6 +30,7 @@ _opam/
 .DS_Store
 
 # Certificates
+*.key
 *.pem
 
 # Sublime Text

README.md

@@ -14,10 +14,16 @@ tidy, feature-complete Web framework.
 Mehari provides several packages. See [here](https://docs.heyplzlookat.me/mehari/index.html#interface).
 Many [examples](https://github.com/Psi-Prod/Mehari/tree/master/examples) are also provided.
 
+## Installation
+
+```
+opam install mehari
+```
+
 ## Features
 
 - [Mirage OS friendly](https://docs.heyplzlookat.me/mehari/Mehari_mirage/index.html)
-- [Static files](https://docs.heyplzlookat.me/mehari/Mehari/module-type-UNIX/index.html#static-files)
+- [Static files serving](https://docs.heyplzlookat.me/mehari/Mehari/module-type-UNIX/index.html#static-files)
 - [MIME type inference](https://docs.heyplzlookat.me/mehari/index.html#mime) (using experimental [Conan](https://github.com/mirage/conan/) support)
 - [Rate limit](https://docs.heyplzlookat.me/mehari/index.html#rate-limit)
 - [Virtual hosting](https://docs.heyplzlookat.me/mehari/index.html#virtual-hosting) using SNI

dune-project

@@ -1,6 +1,8 @@
 (lang dune 3.0)
 
-(version 0.1)
+(using mdx 0.1)
+
+(version 0.2)
 
 (name mehari)
 
@@ -25,31 +27,29 @@
  (depends
   (ocaml
    (>= 4.14))
-  (conan-database
-   (>= 0.0.1))
   (conan
-   (>= 0.0.1))
+   (>= 0.0.2))
   (logs
    (>= 0.7.0))
   (magic-mime
    (>= 1.3.0))
   (mirage-clock
    (>= 4.2.0))
+  (re
+   (>= 1.10.4))
   (tls
-   (>= 0.15.4))
+   (>= 0.16.0))
   (uri
    (>= 4.2.0))
   (x509
-   (>= 0.16.2))
-  (re
-   (>= 1.10.4))))
+   (>= 0.16.2))))
 
 (package
  (name mehari-mirage)
  (synopsis "Mehari IO implementation for MirageOS")
  (depends
   (mehari
-   (= version))
+   (= :version))
   (ipaddr
    (>= 5.3.1))
   (lwt
@@ -70,9 +70,9 @@
  (synopsis "Mehari IO implementation using Lwt and Unix bindings")
  (depends
   (mehari
-   (= version))
+   (= :version))
   (mehari-mirage
-   (= version))
+   (= :version))
   (lwt
    (>= 5.6.1))
   (lwt_ppx
@@ -93,9 +93,9 @@
   (ocaml
    (>= 5.0.0))
   (mehari
-   (= version))
+   (= :version))
   (eio
-   (>= 0.7))
+   (>= 0.8))
   (mirage-clock-unix
    (>= 4.2.0))
   (logs
@@ -106,16 +106,3 @@
    (>= 0.15.5))
   (uri
    (>= 4.2.0))))
-
-(package
- (name mehari-eio-unix)
- (synopsis "Mehari IO implementation using Eio and Unix bindings")
- (depends
-  (ocaml
-   (>= 5.0.0))
-  (mehari
-   (= version))
-  (mehari-eio
-   (= version))
-  (eio
-   (>= 0.7))))

examples/README.md

@@ -11,3 +11,16 @@
 - [stream](stream.ml) — take advantage of Eio's direct style to setup a request handler to stream a response body instead of plain text.
 - [cgi](cgi.ml) — demonstrates CGI support. Don't forget to make `cgi_script.py` executable.
 - [vhost](vhost.ml) — demonstrates the virtual hosting support.
+
+## Unikernel
+
+[unikernel/](unikernel/) is a simple unikernel which serves files located in [unikernel/gemtext/](unikernel/gemtext/).
+Copy your private key in [unikernel/tls/server.key](unikernel/tls/server.key) and your certificate in [unikernel/tls/server.pem](unikernel/tls/server.pem) and run the following:
+
+```bash
+$ cd unikernel/
+$ mirage configure -t unix # initial setup for UNIX backend
+$ make depend # install dependencies
+$ make # build the program
+$ ./gemini-srv # run the program
+```

examples/cgi.ml

@@ -1,9 +1,13 @@
 module Mehari_io = Mehari_lwt_unix
+open Lwt.Infix
 
-let () =
+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
+  |> Mehari_io.run_lwt ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/client_cert.ml

@@ -12,9 +12,14 @@ let router =
     ]
 
 let main ~net ~cwd =
-  Mehari_eio.run net
-    ~certchains:Eio.Path.[ (cwd / "cert.pem", cwd / "key.pem") ]
-    router
+  let certchains =
+    Eio.Path.
+      [
+        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
+          ~priv_key:(cwd / "key.pem");
+      ]
+  in
+  Mehari_eio.run net ~certchains router
 
 let () =
   Eio_main.run @@ fun env ->

examples/counter.ml

@@ -1,23 +1,26 @@
-open Mehari
 module Mehari_io = Mehari_lwt_unix
+open Lwt.Infix
 
 let counter = ref 0
 
 let incr_count handler req =
   incr counter;
   handler req
 
-let () =
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
   Mehari_io.router
     [
       Mehari_io.route "/" (fun _ ->
+          let open Mehari.Gemtext in
           Mehari_io.respond_gemtext
-            Gemtext.
-              [
-                link "/incr" ~name:"Increment counter";
-                text (Printf.sprintf "Counter = %i" !counter);
-              ]);
+            [
+              link "/incr" ~name:"Increment counter";
+              text (Printf.sprintf "Counter = %i" !counter);
+            ]);
       Mehari_io.route "/incr" ~mw:incr_count (fun _ ->
           Mehari_io.respond Mehari.redirect_temp "/");
     ]
-  |> Mehari_io.run
+  |> Mehari_io.run_lwt ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/dune

@@ -17,7 +17,6 @@
   eio_main
   mehari
   mehari-eio
-  mehari-eio-unix
   mehari-lwt-unix
   mirage-crypto-rng-eio
   logs

examples/echo.ml

@@ -1,9 +1,14 @@
 module Mehari_io = Mehari_lwt_unix
+open Lwt.Infix
 
-let () =
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
   Mehari_io.router
     [
-      Mehari_io.route ~typ:`Regex "/echo/(.*)" (fun req ->
+      Mehari_io.route ~regex:true "/echo/(.*)" (fun req ->
           Mehari.param req 1 |> Mehari_io.respond_text);
     ]
-  |> Mehari_io.logger |> Mehari_io.run
+  |> Mehari_io.logger
+  |> Mehari_io.run_lwt ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/eio_backend.ml

@@ -2,14 +2,19 @@ let router cwd =
   Mehari_eio.router
     [
       Mehari_eio.route "/" (fun _ ->
-          Mehari_eio_unix.response_document Eio.Path.(cwd / "README.md"));
-      Mehari_eio.route ~typ:`Regex "/sources/(.*)" (Mehari_eio_unix.static cwd);
+          Mehari_eio.response_document Eio.Path.(cwd / "README.md"));
+      Mehari_eio.route ~regex:true "/sources/(.*)" (Mehari_eio.static cwd);
     ]
 
 let main ~net ~cwd =
-  Mehari_eio.run net
-    ~certchains:Eio.Path.[ (cwd / "cert.pem", cwd / "key.pem") ]
-    (router cwd)
+  let certchains =
+    Eio.Path.
+      [
+        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
+          ~priv_key:(cwd / "key.pem");
+      ]
+  in
+  Mehari_eio.run net ~certchains (router cwd)
 
 let () =
   Eio_main.run @@ fun env ->

examples/guestbook.ml

@@ -20,8 +20,10 @@ let book =
   end
 
 module Mehari_io = Mehari_lwt_unix
+open Lwt.Infix
 
-let () =
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
   Mehari_io.router
     [
       Mehari_io.route "/" (fun _ ->
@@ -42,4 +44,6 @@ let () =
               book#add_entry ~addr:(Mehari.ip req) msg;
               Mehari_io.respond Mehari.redirect_temp "/");
     ]
-  |> Mehari_io.run
+  |> Mehari_io.run_lwt ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/hello.ml

@@ -1 +1,9 @@
-let () = (fun _ -> Mehari_lwt_unix.respond_text "Hello") |> Mehari_lwt_unix.run
+open Lwt.Infix
+
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem"
+  >>= fun certchain ->
+  (fun _ -> Mehari_lwt_unix.respond_text "Hello")
+  |> Mehari_lwt_unix.run_lwt ~certchains:[ certchain ]
+
+let () = Lwt_main.run (main ())

examples/log.ml

@@ -1,17 +1,27 @@
 module Mehari_io = 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;
   Logs.set_level (Some Info);
   Logs.set_reporter (Logs_fmt.reporter ())
 
-let () =
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
   Mehari_io.router
     [
       Mehari_io.route "/" (fun _ ->
           incr n;
           Mehari_io.info (fun log -> log "Request n°: %i" !n);
           Mehari_io.respond_text "This request is logged");
     ]
-  |> Mehari_io.logger |> Mehari_io.run
+  |> Mehari_io.logger
+  |> Mehari_io.run_lwt ~v4:ipv4 ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/proxy.ml

@@ -10,7 +10,13 @@ let router =
     ]
 
 let main ~net ~cwd =
-  let certchains = Eio.Path.[ (cwd / "cert.pem", cwd / "key.pem") ] in
+  let certchains =
+    Eio.Path.
+      [
+        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
+          ~priv_key:(cwd / "key.pem");
+      ]
+  in
   Mehari_eio.run net ~certchains ~verify_url_host:false router
 
 let () =

examples/rate_limit.ml

@@ -1,14 +1,18 @@
 module Mehari_io = 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 () =
+let main () =
+  X509_lwt.private_of_pems ~cert:"cert.pem" ~priv_key:"key.pem" >>= fun cert ->
   Mehari_io.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");
     ]
-  |> Mehari_io.run
+  |> Mehari_io.run_lwt ~certchains:[ cert ]
+
+let () = Lwt_main.run (main ())

examples/stream.ml

@@ -19,9 +19,14 @@ let router clock req =
           Mehari.(response_body body plaintext))
 
 let main ~clock ~cwd ~net =
-  Mehari_eio.run net
-    ~certchains:Eio.Path.[ (cwd / "cert.pem", cwd / "key.pem") ]
-    (router clock)
+  let certchains =
+    Eio.Path.
+      [
+        X509_eio.private_of_pems ~cert:(cwd / "cert.pem")
+          ~priv_key:(cwd / "key.pem");
+      ]
+  in
+  Mehari_eio.run net ~certchains (router clock)
 
 let () =
   Eio_main.run @@ fun env ->

examples/unikernel/config.ml

@@ -0,0 +1,29 @@
+open Mirage
+
+let port =
+  let doc =
+    Key.Arg.info
+      ~doc:"The TCP port on which to listen for incoming connections."
+      [ "port" ]
+  in
+  Key.(create "port" Arg.(opt (some int) None doc))
+
+let static_key = Key.(value @@ kv_ro ~group:"static" ())
+let static = generic_kv_ro ~key:static_key "gemtext"
+let certs_key = Key.(value @@ kv_ro ~group:"certs" ())
+let certs = generic_kv_ro ~key:certs_key "tls"
+
+let main =
+  foreign
+    ~keys:Key.[ v port ]
+    ~packages:[ package "mehari"; package "mehari-mirage" ]
+    "Unikernel.GeminiServer"
+    (random @-> kv_ro @-> kv_ro @-> pclock @-> stackv4v6 @-> time @-> job)
+
+let () =
+  register "gemini-srv"
+    [
+      main $ default_random $ static $ certs $ default_posix_clock
+      $ generic_stackv4v6 default_network
+      $ default_time;
+    ]

examples/unikernel/gemtext/gemlog.gmi

@@ -0,0 +1 @@
+# My gemlog