Add a key "--delay" to delay unikernel startup by specified amount of…

… seconds

solves #1468

lib/mirage/mirage.ml

@@ -301,6 +301,26 @@ let git_http ?authenticator ?headers ?(pclock = default_posix_clock) tcpv4v6 ctx
     =
   Mirage_impl_git.git_http ?authenticator headers $ pclock $ tcpv4v6 $ ctx
 
+let delay = job
+
+let delay_startup =
+  let delay_key = Key.delay in
+  let keys = [ Key.v delay_key ] in
+  let packages = [ package ~max:"1.0.0" "duration" ] in
+  let modname = ref "" in
+  let configure i =
+    modname :=
+      (match Mirage_impl_misc.get_target i with
+       | `Unix | `MacOSX -> "Unix_os.Time"
+       | `Xen | `Qubes -> "Xen_os.Time"
+       | `Virtio | `Hvt | `Spt | `Muen | `Genode -> "Solo5_os.Time");
+    Action.ok ()
+  in
+  let connect _ _ _ =
+    Fmt.str "%s.sleep_ns (Duration.of_sec %a)" !modname Mirage_impl_misc.pp_key delay_key
+  in
+  impl ~packages ~keys ~configure ~connect "Mirage_runtime" delay
+
 (** Functoria devices *)
 
 type info = Functoria.info
@@ -488,7 +508,7 @@ let register ?(argv = default_argv) ?(reporter = default_reporter ())
        instead of `.. job .. [ main ]`.";
   let first = [ keys argv; backtrace; randomize_hashtables; gc_control ] in
   let reporter = if reporter == no_reporter then None else Some reporter in
-  let init = Some first ++ reporter in
+  let init = Some first ++ Some delay_startup ++ reporter in
   register ?keys:extra_keys ?packages ?init ?src name jobs
 
 module Action = Functoria.Action

lib/mirage/mirage_key.ml

@@ -298,6 +298,11 @@ let create_simple ?(group = "") ?(stage = `Both) ~doc ~default conv name =
   let key = Arg.opt ~stage conv default doc in
   Key.create (prefix ^ name) key
 
+(** {3 Initial delay} *)
+let delay =
+  let doc = Fmt.str "Delay n seconds before starting up" in
+  create_simple ~doc ~default:0 Arg.int "delay"
+
 (** {3 File system keys} *)
 
 let kv_ro ?group () =

lib/mirage/mirage_key.mli

@@ -100,9 +100,16 @@ val custom_minor_max_size : int option key
 
     If a key has another, non-optional argument. It is the default value.
 
-    Keys are always named the same as their command line option.
+    Keys are always named the same as their command line option. *)
 
-    {3 File system keys} *)
+(** {3 Startup delay} *)
+
+val delay : int key
+(** The initial delay, specified in seconds, before a unikernel starting up.
+    Defaults to 0. Useful for tenders and environments that take some time to
+    bring devices up. *)
+
+(** {3 File system keys} *)
 
 val kv_ro : ?group:string -> unit -> [ `Crunch | `Direct ] key
 (** The type of key value store. Is one of ["crunch"], or ["direct"]. *)