Update to latest mirage

applications/dns/config.ml

@@ -1,22 +1,14 @@
 open Mirage
 
-let domain_name =
-  let doc = Key.Arg.info ~doc:"The domain-name to resolve." [ "domain-name" ] in
-  Key.(create "domain-name" Arg.(required ~stage:`Run string doc))
-
 let nameservers =
   let doc = Key.Arg.info ~doc:"Nameserver." [ "nameserver" ] in
-  Key.(create "nameserver" Arg.(opt_all string doc))
+  Key.(create "nameserver" Arg.(opt_all ~stage:`Run string doc))
 
 let timeout =
   let doc = Key.Arg.info ~doc:"Timeout of DNS requests." [ "timeout" ] in
-  Key.(create "timeout" Arg.(opt (some int64) None doc))
-
-let unikernel =
-  foreign "Unikernel.Make"
-    ~keys:[ Key.v domain_name; Key.v nameservers ]
-    (dns_client @-> job)
+  Key.(create "timeout" Arg.(opt ~stage:`Run (some int64) None doc))
 
+let unikernel = foreign "Unikernel.Make" (dns_client @-> job)
 let stackv4v6 = generic_stackv4v6 default_network
 
 let () =

applications/dns/unikernel.ml

@@ -1,7 +1,14 @@
+open Cmdliner
+
+let domain_name =
+  let doc = Arg.info ~doc:"The domain-name to resolve." [ "domain-name" ] in
+  let key = Arg.(required & opt (some string) None doc) in
+  Mirage_runtime.key key
+
 module Make (DNS : Dns_client_mirage.S) = struct
   let start dns =
     let ( >>= ) = Result.bind in
-    match Domain_name.(of_string (Key_gen.domain_name ()) >>= host) with
+    match Domain_name.(of_string (domain_name ()) >>= host) with
     | Error (`Msg err) -> failwith err
     | Ok domain_name -> (
         let open Lwt.Infix in

applications/docteur/config.ml

@@ -1,10 +1,6 @@
 open Mirage
 
-let filename =
-  let doc = Key.Arg.info ~doc:"The filename to print out." [ "filename" ] in
-  Key.(create "filename" Arg.(required ~stage:`Run string doc))
-
-let unikernel = foreign "Unikernel.Make" ~keys:[ Key.v filename ] (kv_ro @-> job)
+let unikernel = foreign "Unikernel.Make" (kv_ro @-> job)
 let remote = "https://github.com/mirage/mirage"
 
 let () =

applications/docteur/unikernel.ml

@@ -1,10 +1,16 @@
 open Lwt.Infix
+open Cmdliner
+
+let filename =
+  let doc = Arg.info ~doc:"The filename to print out." [ "filename" ] in
+  let key = Arg.(required & opt (some string) None doc) in
+  Mirage_runtime.key key
 
 module Make (Store : Mirage_kv.RO) = struct
   module Key = Mirage_kv.Key
 
   let start store =
-    Store.get store (Key.v (Key_gen.filename ())) >|= function
+    Store.get store (Key.v (filename ())) >|= function
     | Error err -> Logs.err (fun m -> m "Error: %a." Store.pp_error err)
     | Ok str -> Logs.info (fun m -> m "%s" str)
 end

applications/git/config.ml

@@ -34,44 +34,36 @@ let git_impl path =
 
 (* User space *)
 
-let remote =
-  let doc = Key.Arg.info ~doc:"Remote Git repository." [ "r"; "remote" ] in
-  Key.(create "remote" Arg.(required ~stage:`Run string doc))
-
 let ssh_key =
   let doc = Key.Arg.info ~doc:"The private SSH key." [ "ssh-key" ] in
-  Key.(create "ssh_seed" Arg.(opt (some string) None doc))
+  Key.(create "ssh_seed" Arg.(opt ~stage:`Run (some string) None doc))
 
 let ssh_password =
   let doc = Key.Arg.info ~doc:"The private SSH password." [ "ssh-password" ] in
-  Key.(create "ssh_password" Arg.(opt (some string) None doc))
+  Key.(create "ssh_password" Arg.(opt ~stage:`Run (some string) None doc))
 
 let nameservers =
   let doc = Key.Arg.info ~doc:"DNS nameservers." [ "nameserver" ] in
-  Key.(create "nameservers" Arg.(opt_all string doc))
+  Key.(create "nameservers" Arg.(opt_all ~stage:`Run string doc))
 
 let ssh_authenticator =
   let doc =
     Key.Arg.info ~doc:"SSH public key of the remote Git repository."
       [ "ssh-authenticator" ]
   in
-  Key.(create "ssh_authenticator" Arg.(opt (some string) None doc))
+  Key.(create "ssh_authenticator" Arg.(opt ~stage:`Run (some string) None doc))
 
 let https_authenticator =
   let doc =
     Key.Arg.info ~doc:"SSH public key of the remote Git repository."
       [ "https-authenticator" ]
   in
-  Key.(create "https_authenticator" Arg.(opt (some string) None doc))
-
-let branch =
-  let doc = Key.Arg.info ~doc:"The Git remote branch." [ "branch" ] in
-  Key.(create "branch" Arg.(opt ~stage:`Run string "refs/heads/master" doc))
+  Key.(
+    create "https_authenticator" Arg.(opt ~stage:`Run (some string) None doc))
 
 let minigit =
   foreign "Unikernel.Make"
     ~packages:[ package "ptime" ]
-    ~keys:[ Key.v remote; Key.v branch ]
     (git @-> git_client @-> job)
 
 let mimic stackv4v6 dns_client happy_eyeballs =

applications/git/unikernel.ml

@@ -1,9 +1,20 @@
+open Cmdliner
 open Lwt.Infix
 
+let branch =
+  let doc = Arg.info ~doc:"The Git remote branch." [ "branch" ] in
+  let key = Arg.(value & opt string "refs/heads/master" doc) in
+  Mirage_runtime.key key
+
+let remote =
+  let doc = Arg.info ~doc:"Remote Git repository." [ "r"; "remote" ] in
+  let key = Arg.(required & opt (some string) None doc) in
+  Mirage_runtime.key key
+
 module Make (Store : Git.S) (_ : sig end) = struct
   module Sync = Git.Mem.Sync (Store)
 
-  let main = lazy (Git.Reference.v (Key_gen.branch ()))
+  let main = lazy (Git.Reference.v (branch ()))
 
   let author () =
     {
@@ -62,7 +73,7 @@ module Make (Store : Git.S) (_ : sig end) = struct
 
   let start git ctx =
     let edn =
-      match Smart_git.Endpoint.of_string (Key_gen.remote ()) with
+      match Smart_git.Endpoint.of_string (remote ()) with
       | Ok edn -> edn
       | Error (`Msg err) -> Fmt.failwith "%s" err
     in

applications/http/config.ml

@@ -2,23 +2,7 @@ open Mirage
 
 let port =
   let doc = Key.Arg.info ~doc:"Port of HTTP service." [ "p"; "port" ] in
-  Key.(create "ports" Arg.(opt int 8080 doc))
-
-let tls =
-  let doc =
-    Key.Arg.info ~doc:"Start an HTTP server with a TLS certificate." [ "tls" ]
-  in
-  Key.(create "tls" Arg.(flag ~stage:`Run doc))
-
-let tls_port =
-  let doc = Key.Arg.info ~doc:"Port of HTTPS service." [ "tls-port" ] in
-  Key.(create "tls-port" Arg.(opt ~stage:`Run int 4343 doc))
-
-let alpn =
-  let doc =
-    Key.Arg.info ~doc:"Protocols handled by the HTTP server." [ "alpn" ]
-  in
-  Key.(create "alpn" Arg.(opt ~stage:`Run (some string) None doc))
+  Key.(create "ports" Arg.(opt ~stage:`Run int 8080 doc))
 
 type conn = Connect
 
@@ -34,7 +18,6 @@ let minipaf =
         package "rresult";
         package "base64" ~sublibs:[ "rfc2045" ];
       ]
-    ~keys:[ Key.v tls_port; Key.v tls; Key.v alpn ]
     (random @-> kv_ro @-> kv_ro @-> tcpv4v6 @-> conn @-> http_server @-> job)
 
 let conn =

applications/http/unikernel.ml

@@ -1,5 +1,23 @@
 open Rresult
 open Lwt.Infix
+open Cmdliner
+
+let use_tls =
+  let doc =
+    Arg.info ~doc:"Start an HTTP server with a TLS certificate." [ "tls" ]
+  in
+  let key = Arg.(value & flag doc) in
+  Mirage_runtime.key key
+
+let tls_port =
+  let doc = Arg.info ~doc:"Port of HTTPS service." [ "tls-port" ] in
+  let key = Arg.(value & opt int 4343 doc) in
+  Mirage_runtime.key key
+
+let alpn =
+  let doc = Arg.info ~doc:"Protocols handled by the HTTP server." [ "alpn" ] in
+  let key = Arg.(value & opt (some string) None doc) in
+  Mirage_runtime.key key
 
 let ( <.> ) f g x = f (g x)
 let always x _ = x
@@ -120,19 +138,19 @@ struct
     let open Lwt.Infix in
     let authenticator = Connect.authenticator in
     tls key_ro certificate_ro >>= fun tls ->
-    match (Key_gen.tls (), tls, Key_gen.alpn ()) with
+    match (use_tls (), tls, alpn ()) with
     | true, Ok certificates, None ->
         run_with_tls ~ctx ~authenticator
           ~tls:
             (Tls.Config.server ~certificates
                ~alpn_protocols:[ "h2"; "http/1.1" ] ())
-          http_server (Key_gen.tls_port ()) tcpv4v6
+          http_server (tls_port ()) tcpv4v6
     | true, Ok certificates, Some (("http/1.1" | "h2") as alpn_protocol) ->
         run_with_tls ~ctx ~authenticator
           ~tls:
             (Tls.Config.server ~certificates ~alpn_protocols:[ alpn_protocol ]
                ())
-          http_server (Key_gen.tls_port ()) tcpv4v6
+          http_server (tls_port ()) tcpv4v6
     | false, _, _ -> run ~ctx ~authenticator http_server
     | _, _, Some protocol -> Fmt.failwith "Invalid protocol %S" protocol
     | true, Error _, _ ->

applications/static_website_tls/config.ml

@@ -6,26 +6,15 @@ let data = generic_kv_ro ~key:data_key "htdocs"
 
 (* set ~tls to false to get a plain-http server *)
 let https_srv = cohttp_server @@ conduit_direct ~tls:true stack
-
-let http_port =
-  let doc = Key.Arg.info ~doc:"Listening HTTP port." [ "http" ] in
-  Key.(create "http_port" Arg.(opt ~stage:`Run int 8080 doc))
-
 let certs_key = Key.(value @@ kv_ro ~group:"certs" ())
 
 (* some default CAs and self-signed certificates are included in
    the tls/ directory, but you can replace them with your own. *)
 let certs = generic_kv_ro ~key:certs_key "tls"
 
-let https_port =
-  let doc = Key.Arg.info ~doc:"Listening HTTPS port." [ "https" ] in
-  Key.(create "https_port" Arg.(opt ~stage:`Run int 4433 doc))
-
 let main =
   let packages = [ package "uri"; package "magic-mime" ] in
-  let keys = List.map key [ http_port; https_port ] in
-  main ~packages ~keys "Dispatch.HTTPS"
-    (pclock @-> kv_ro @-> kv_ro @-> http @-> job)
+  main ~packages "Dispatch.HTTPS" (pclock @-> kv_ro @-> kv_ro @-> http @-> job)
 
 let () =
   register "https" [ main $ default_posix_clock $ data $ certs $ https_srv ]

applications/static_website_tls/dispatch.ml

@@ -1,4 +1,15 @@
 open Lwt.Infix
+open Cmdliner
+
+let http_port =
+  let doc = Arg.info ~doc:"Listening HTTP port." [ "http" ] in
+  let key = Arg.(value & opt int 8080 doc) in
+  Mirage_runtime.key key
+
+let https_port =
+  let doc = Arg.info ~doc:"Listening HTTPS port." [ "https" ] in
+  let key = Arg.(value & opt int 4433 doc) in
+  Mirage_runtime.key key
 
 module type HTTP = Cohttp_mirage.Server.S
 (** Common signature for http and https. *)
@@ -72,9 +83,9 @@ struct
 
   let start _clock data keys http =
     tls_init keys >>= fun cfg ->
-    let https_port = Key_gen.https_port () in
+    let https_port = https_port () in
     let tls = `TLS (cfg, `TCP https_port) in
-    let http_port = Key_gen.http_port () in
+    let http_port = http_port () in
     let tcp = `TCP http_port in
     let https =
       Https_log.info (fun f -> f "listening on %d/TCP" https_port);

device-usage/http-fetch/config.ml

@@ -1,12 +1,8 @@
 open Mirage
 
-let uri =
-  let doc = Key.Arg.info ~doc:"URL to fetch" [ "uri" ] in
-  Key.(create "uri" Arg.(opt ~stage:`Run string "https://mirage.io" doc))
-
 let client =
   let packages = [ package "cohttp-mirage"; package "duration" ] in
-  main ~keys:[ key uri ] ~packages "Unikernel.Client" @@ http_client @-> job
+  main ~packages "Unikernel.Client" @@ http_client @-> job
 
 let () =
   let stack = generic_stackv4v6 default_network in

device-usage/http-fetch/unikernel.ml

@@ -1,5 +1,11 @@
 open Lwt.Infix
 open Printf
+open Cmdliner
+
+let uri =
+  let doc = Arg.info ~doc:"URL to fetch" [ "uri" ] in
+  let key = Arg.(value & opt string "https://mirage.io" doc) in
+  Mirage_runtime.key key
 
 let red fmt = sprintf ("\027[31m" ^^ fmt ^^ "\027[m")
 let green fmt = sprintf ("\027[32m" ^^ fmt ^^ "\027[m")
@@ -16,6 +22,6 @@ module Client (Client : Cohttp_lwt.S.Client) = struct
     Fmt.pr "Cohttp fetch done\n------------\n"
 
   let start ctx =
-    let uri = Uri.of_string (Key_gen.uri ()) in
+    let uri = Uri.of_string (uri ()) in
     http_fetch ctx uri
 end

device-usage/network/config.ml

@@ -1,13 +1,5 @@
 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 ~stage:`Run int 8080 doc))
-
-let main = main ~keys:[ key port ] "Unikernel.Main" (stackv4v6 @-> job)
+let main = main "Unikernel.Main" (stackv4v6 @-> job)
 let stack = generic_stackv4v6 default_network
 let () = register "network" [ main $ stack ]

device-usage/network/unikernel.ml

@@ -1,8 +1,17 @@
 open Lwt.Infix
+open Cmdliner
+
+let port =
+  let doc =
+    Arg.info ~doc:"The TCP port on which to listen for incoming connections."
+      [ "port" ]
+  in
+  let key = Arg.(value & opt int 8080 doc) in
+  Mirage_runtime.key key
 
 module Main (S : Tcpip.Stack.V4V6) = struct
   let start s =
-    let port = Key_gen.port () in
+    let port = port () in
     S.TCP.listen (S.tcp s) ~port (fun flow ->
         let dst, dst_port = S.TCP.dst flow in
         Logs.info (fun f ->

device-usage/prng/unikernel.ml

@@ -1,20 +1,8 @@
 module Main (R : Mirage_random.S) = struct
-  let t_to_str = function
-    | `Unix -> "unix"
-    | `Xen -> "xen"
-    | `Muen -> "muen"
-    | `Qubes -> "qubes"
-    | `MacOSX -> "macosx"
-    | `Virtio -> "virtio"
-    | `Hvt -> "hvt"
-    | `Spt -> "spt"
-
   let generate i = R.generate i
 
   let start _r =
-    let t = Key_gen.target () in
-    Logs.info (fun m ->
-        m "PRNG example running on %s (target %s)" Sys.os_type (t_to_str t));
+    Logs.info (fun m -> m "PRNG example running on %s" Sys.os_type);
     Logs.info (fun m ->
         m "using Fortuna, entropy sources: %a"
           Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)

tutorial/hello-key/config.ml

@@ -1,13 +1,4 @@
 open Mirage
 
-let hello =
-  let doc = Key.Arg.info ~doc:"How to say hello." [ "hello" ] in
-  Key.(create "hello" Arg.(opt ~stage:`Run string "Hello World!" doc))
-
-let main =
-  main
-    ~keys:[ key hello ]
-    ~packages:[ package "duration" ]
-    "Unikernel.Hello" (time @-> job)
-
+let main = main ~packages:[ package "duration" ] "Unikernel.Hello" (time @-> job)
 let () = register "hello-key" [ main $ default_time ]