Add a README.md

README.md

@@ -0,0 +1,40 @@
+# Vif, a small framework for building a web server from an OCaml script
+
+**disclaimer**: Please note that this is an experimental project. It's also an
+opportunity to build something that can be satisfying for web development.
+However, we do not recommend using this project in production.
+
+Vif is a small program that runs an OCaml script and launches a Web server from
+it. The main idea is to be able to set up a typed Web server as quickly as
+possible (note that we use [hurl][hurl], an HTTP client in OCaml)
+```ocaml
+$ opam pin add -y https://github.com/robur-coop/vif
+$ opam pin add -y https://github.com/robur-coop/hurl
+$ opam install vif hurl
+$ cat >main.ml <<EOF
+#require "vif" ;;
+
+let default req target server () =
+  let headers = [ "content-type", "text/html" ] in
+  Vif.Response.with_string ~headers server `OK "Hello World!\n"
+;;
+
+let () =
+  Miou_unix.run @@ fun () ->
+  Vif.run ~default [] ()
+;;
+EOF
+$ vif --pid vif.pid main.ml &
+$ hurl http://localhost:8080/
+HTTP/1.1 200 OK
+
+connection: close
+content-length: 13
+content-type: text/html
+
+Hello World!
+
+$ kill -SIGINT $(cat vid.pid)
+```
+
+[hurl]: https://github.com/robur-coop/hurl

lib/vif/vif.ml

@@ -158,10 +158,18 @@ let handle stop cfg fn =
       Log.debug (fun m -> m "Start a non-tweaked HTTP/1.1 server");
       Httpcats.Server.clear ?stop ~handler:fn cfg.sockaddr
 
+let store_pid = function
+  | None -> ()
+  | Some v ->
+      let oc = open_out (Fpath.to_string v) in
+      output_string oc (string_of_int (Unix.getpid ()));
+      close_out oc
+
 let run ?(cfg = Vif_options.config_from_globals ()) ?(devices = Ds.[]) ~default
     routes user's_value =
   let interactive = !Sys.interactive in
   let domains = Miou.Domain.available () in
+  store_pid cfg.pid;
   let stop =
     match interactive with
     | true ->

lib/vif/vif.mli

@@ -240,7 +240,8 @@ end
 type config
 
 val config :
-     ?http:
+     ?pid:Fpath.t
+  -> ?http:
        [ `H1 of H1.Config.t
        | `H2 of H2.Config.t
        | `Both of H1.Config.t * H2.Config.t ]

lib/vif/vif_config.ml

@@ -7,9 +7,10 @@ type config = {
   ; tls: Tls.Config.server option
   ; backlog: int
   ; sockaddr: Unix.sockaddr
+  ; pid: Fpath.t option
 }
 
-let config ?http ?tls ?(backlog = 64) sockaddr =
+let config ?pid ?http ?tls ?(backlog = 64) sockaddr =
   let http =
     match http with
     | Some (`H1 cfg) -> Some (`HTTP_1_1 cfg)
@@ -17,4 +18,4 @@ let config ?http ?tls ?(backlog = 64) sockaddr =
     | Some (`Both (h1, h2)) -> Some (`Both (h1, h2))
     | None -> None
   in
-  { http; tls; backlog; sockaddr }
+  { http; tls; backlog; sockaddr; pid }

lib/vif/vif_options.ml

@@ -2,15 +2,17 @@ let error_msgf fmt = Fmt.kstr (fun msg -> Error (`Msg msg)) fmt
 let port = ref 8080
 let inet_addr = ref Unix.inet_addr_loopback
 let backlog = ref 64
+let pid = ref None
 
-let setup_config port' inet_addr' backlog' =
+let setup_config port' inet_addr' backlog' pid' =
   port := port';
   inet_addr := inet_addr';
-  backlog := backlog'
+  backlog := backlog';
+  pid := pid'
 
 let config_from_globals () =
   let sockaddr = Unix.(ADDR_INET (!inet_addr, !port)) in
-  Vif_config.config ~backlog:!backlog sockaddr
+  Vif_config.config ?pid:!pid ~backlog:!backlog sockaddr
 
 open Cmdliner
 
@@ -32,6 +34,22 @@ let inet_addr =
   & opt inet_addr Unix.inet_addr_loopback
   & info [ "i"; "inet-addr" ] ~doc ~docv:"INET_ADDR"
 
+let pid =
+  let doc = "Specify a file to record its process-id in." in
+  let non_existing_file =
+    let parser str =
+      match Fpath.of_string str with
+      | Ok _ as v when Sys.file_exists str = false -> v
+      | Ok v -> error_msgf "%a already exists" Fpath.pp v
+      | Error _ as err -> err
+    in
+    Arg.conv (parser, Fpath.pp)
+  in
+  let open Arg in
+  value
+  & opt (some non_existing_file) None
+  & info [ "pid-file" ] ~doc ~docv:"PATH"
+
 let backlog =
   let doc =
     "The limit of outstanding connections in the socket's listen queue."
@@ -41,4 +59,4 @@ let backlog =
 
 let setup_config =
   let open Term in
-  const setup_config $ port $ inet_addr $ backlog
+  const setup_config $ port $ inet_addr $ backlog $ pid

main.ml

@@ -1,93 +0,0 @@
-#require "miou.unix"
-
-#require "mirage-crypto-rng-miou-unix"
-
-#require "vif"
-
-#require "digestif.c"
-
-#require "base64"
-
-type cfg = Config
-
-let index _req server Config =
-  Vif.Response.with_string server `OK "Hello from an OCaml script!"
-
-let hex _req arg server Config =
-  Vif.Response.with_string server `OK (Fmt.str "%02x\n%!" arg)
-
-let digest req server Config =
-  let ic = Vif.Request.to_stream req in
-  let rec go ctx =
-    match Vif.Stream.get ic with
-    | Some str -> go (Digestif.SHA1.feed_string ctx str)
-    | None -> Digestif.SHA1.get ctx
-  in
-  let hash = go Digestif.SHA1.empty in
-  let hash = Digestif.SHA1.to_hex hash in
-  Vif.Response.with_string server `OK hash
-
-let random req len server Config =
-  let buf = Bytes.create 0x7ff in
-  Vif.Response.with_stream server `OK @@ fun oc ->
-  let rec go rem =
-    if rem > 0 then begin
-      let len = Int.min rem (Bytes.length buf) in
-      Mirage_crypto_rng.generate_into buf len;
-      let str = Bytes.sub_string buf 0 len in
-      let str = Base64.encode_exn str in
-      Vif.Stream.put oc str;
-      go (rem - len)
-    end
-  in
-  go len
-
-type foo = { username: string; password: string; age: int option }
-
-let foo =
-  let open Json_encoding in
-  let username = req "username" string in
-  let password = req "password" string in
-  let age = opt "age" int in
-  let foo = obj3 username password age in
-  let inj (username, password, age) = { username; password; age } in
-  let prj { username; password; age } = (username, password, age) in
-  conv prj inj foo
-
-let login req server Config =
-  match Vif.Request.to_json req with
-  | Ok (foo : foo) ->
-      Logs.debug (fun m -> m "username: %s" foo.username);
-      Logs.debug (fun m -> m "password: %s" foo.password);
-      Vif.Response.with_string server `OK "Foo"
-  | Error (`Msg err) ->
-      Logs.err (fun m -> m "Invalid JSON: %s" err);
-      Vif.Response.with_string server `Not_acceptable err
-
-let routes =
-  let open Vif.U in
-  let open Vif.R in
-  let open Vif.Content_type in
-  [
-    get (rel /?? nil) --> index
-  ; get (rel / "random" /% Tyre.int /?? nil) --> random
-  ; get (rel / "hex" /% Tyre.int /?? nil) --> hex
-  ; post any (rel / "digest" /?? nil) --> digest
-  ; post (json_encoding foo) (rel / "json" /?? nil) --> login
-  ]
-
-let default req target server Config =
-  Logs.debug (fun m -> m "We are into the default case");
-  Vif.Response.with_string server `Not_found (Fmt.str "%S not found\n%!" target)
-
-let rng =
-  let open Mirage_crypto_rng_miou_unix in
-  let finally = kill in
-  Vif.D.device ~name:"rng" ~finally [] @@ fun Config ->
-  initialize (module Pfortuna)
-
-let () =
-  Miou_unix.run @@ fun () ->
-  let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, 8080)) in
-  let cfg = Vif.config sockaddr in
-  Vif.run ~cfg ~default ~devices:Vif.Ds.[ rng ] routes Config