unikernel/duniverse/mirage/lib_runtime/dune

@@ -0,0 +1,11 @@
+(library
+ (name mirage_runtime)
+ (public_name mirage-runtime)
+ (modules mirage_runtime)
+ (libraries mirage-runtime.functoria lwt logs))
+
+(library
+ (name mirage_runtime_network)
+ (public_name mirage-runtime.network)
+ (modules mirage_runtime_network)
+ (libraries mirage-runtime mirage-runtime.functoria ipaddr))

unikernel/duniverse/mirage/lib_runtime/functoria/dune

@@ -0,0 +1,4 @@
+(library
+ (name functoria_runtime)
+ (public_name mirage-runtime.functoria)
+ (libraries cmdliner))

unikernel/duniverse/mirage/lib_runtime/functoria/functoria_runtime.ml

@@ -0,0 +1,88 @@
+(*
+ * Copyright (c) 2015 Gabriel Radanne <drupyog@zoho.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let runtime_args_r = ref []
+let runtime_args () = !runtime_args_r
+
+module Arg = struct
+  type 'a t = { arg : 'a Cmdliner.Term.t; mutable value : 'a option }
+
+  let create arg = { arg; value = None }
+
+  let get t =
+    match t.value with
+    | None ->
+        invalid_arg
+          "Called too early. Please delay this call to after the start \
+           function of the unikernel."
+    | Some v -> v
+
+  let term (type a) (t : a t) =
+    let set w = t.value <- Some w in
+    Cmdliner.Term.(const set $ t.arg)
+end
+
+let initialized = ref false
+
+let register_arg t =
+  if !initialized then
+    invalid_arg
+      "The function register_arg was called to late. Please call register_arg \
+       before the start function is executed (e.g. in a top-level binding).";
+  let u = Arg.create t in
+  runtime_args_r := Arg.term u :: !runtime_args_r;
+  fun () -> Arg.get u
+
+let register = register_arg
+let help_version = 63
+let argument_error = 64
+
+let with_argv ?sections keys s argv =
+  let open Cmdliner in
+  if !initialized then ()
+  else
+    let gather k rest = Term.(const (fun () () -> ()) $ k $ rest) in
+    let t = List.fold_right gather keys (Term.const ()) in
+    let exits =
+      [
+        Cmd.Exit.info ~doc:"on success." Cmd.Exit.ok;
+        Cmd.Exit.info ~doc:"on Solo5 internal error." 1;
+        Cmd.Exit.info ~doc:"on showing this help." help_version;
+        Cmd.Exit.info ~doc:"on any argument parsing error." argument_error;
+        Cmd.Exit.info
+          ~doc:
+            "on unexpected internal errors (bugs) while processing the boot \
+             parameters."
+          Cmd.Exit.internal_error;
+        Cmd.Exit.info ~doc:"on OCaml uncaught exception." 255;
+      ]
+    in
+    let man = Option.map (List.map (fun s -> `S s)) sections in
+    match Cmd.(eval_value ~argv (Cmd.v (info ?man ~exits s) t)) with
+    | Ok (`Ok _) ->
+        initialized := true;
+        ()
+    | Error `Parse -> exit argument_error
+    | Error `Term ->
+        print_endline
+          "Hint: To pass a space, it needs to be escaped twice: \
+           \027[1m--hello='Hello,\\ world!'\027[m";
+        print_endline
+          "      Another possibility is: \027[1m--hello='\"Hello, \
+           world!\"'\027[m";
+        exit argument_error
+    | Error `Exn -> exit Cmd.Exit.internal_error
+    | Ok `Help | Ok `Version -> exit help_version

unikernel/duniverse/mirage/lib_runtime/functoria/functoria_runtime.mli

@@ -0,0 +1,57 @@
+(*
+ * Copyright (c) 2013-2020 Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (c) 2013-2020 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2015-2020 Gabriel Radanne <drupyog@zoho.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Functoria runtime. *)
+
+val register : 'a Cmdliner.Term.t -> unit -> 'a
+[@@ocaml.deprecated "Use register_arg instead."]
+(** [register t] registers the Cmdliner term [k] as a runtime argument and
+    return a callback [f] that evaluates to [t]s' value passed on the
+    command-line.
+
+    [f] will raise [Invalid_argument] if called before cmdliner's evaluation. *)
+
+val register_arg : 'a Cmdliner.Term.t -> unit -> 'a
+(** [register_arg t] registers the Cmdliner term [k] as a runtime argument and
+    return a callback [f] that evaluates to [t]s' value passed on the
+    command-line.
+
+    [f] will raise [Invalid_argument] if called before cmdliner's evaluation. *)
+
+val with_argv :
+  ?sections:string list ->
+  unit Cmdliner.Term.t list ->
+  string ->
+  string array ->
+  unit
+(** [with_argv ?sections arguments name argv] evaluates the [arguments]
+    {{!Key.term} terms} on the command-line [argv]. [name] is the executable
+    name. [sections] is a list of sections to include in the man page - useful
+    for enforcing a specific order of sections. On evaluation error the
+    application calls [exit(3)] with status [64]. If [`Help] or [`Version] were
+    evaluated, [exit(3)] is called with status [63]. *)
+
+val runtime_args : unit -> unit Cmdliner.Term.t list
+
+(** {2 Exit Codes} *)
+
+val argument_error : int
+(** [argument_error] is the exit code used for argument parsing errors: 64. *)
+
+val help_version : int
+(** [help_version] is the exit code used when help/version is used: 63. *)

unikernel/duniverse/mirage/lib_runtime/mirage_runtime.ml

@@ -0,0 +1,188 @@
+(*
+ * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Cmdliner
+
+(* The order of the argument sections in the manpage can be enforced in the call to [with_argv] *)
+let s_net = "NETWORK OPTIONS"
+let s_dns = "DNS OPTIONS"
+let s_he = "HAPPY EYEBALLS OPTIONS"
+let s_ssh = "SSH OPTIONS"
+let s_tls = "TLS OPTIONS"
+let s_http = "HTTP OPTIONS"
+let s_log = "LOG AND MONITORING OPTIONS"
+let s_disk = "DISK OPTIONS"
+let s_ocaml = "OCAML RUNTIME OPTIONS"
+
+type log_threshold = [ `All | `Src of string ] * Logs.level option
+
+(* We provisionally record backtraces until the [backtrace] runtime argument
+   further below is evaluated. This ensures we get proper backtraces if someone
+   calls [register_arg _ ()] too early before command line arguments are
+   evaluated. *)
+let () = Printexc.record_backtrace true
+
+let set_level ~default l =
+  let srcs = Logs.Src.list () in
+  let default =
+    try snd @@ List.find (function `All, _ -> true | _ -> false) l
+    with Not_found -> default
+  in
+  Logs.set_level default;
+  List.iter
+    (function
+      | `All, _ -> ()
+      | `Src src, level -> (
+          try
+            let s = List.find (fun s -> Logs.Src.name s = src) srcs in
+            Logs.Src.set_level s level
+          with Not_found ->
+            Format.printf "WARNING: %s is not a valid log source.\n%!" src))
+    l
+
+module Conv = struct
+  let log_threshold =
+    let parser str =
+      let level src s =
+        Result.bind (Logs.level_of_string s) (fun l -> Ok (src, l))
+      in
+      match String.split_on_char ':' str with
+      | [ _ ] -> level `All str
+      | [ "*"; lvl ] -> level `All lvl
+      | [ src; lvl ] -> level (`Src src) lvl
+      | _ -> Error (`Msg ("Can't parse log threshold: " ^ str))
+    in
+    let serialize ppf = function
+      | `All, l -> Format.pp_print_string ppf (Logs.level_to_string l)
+      | `Src s, l -> Format.fprintf ppf "%s:%s" s (Logs.level_to_string l)
+    in
+    Arg.conv (parser, serialize)
+end
+
+let logs =
+  let enum =
+    List.map
+      (fun v -> (Logs.level_to_string v, v))
+      Logs.[ None; Some App; Some Error; Some Warning; Some Info; Some Debug ]
+  in
+  let docs = s_log in
+  let logs = Arg.list Conv.log_threshold in
+  let doc =
+    Printf.sprintf
+      "Be more or less verbose. $(docv) must be of the form \
+       $(b,*:info,foo:debug) means that that the log threshold is set to \
+       $(b,info) for every log sources but the $(b,foo) which is set to \
+       $(b,debug). The log level must be %s."
+      (Arg.doc_alts_enum enum)
+  in
+  let doc = Arg.info ~docv:"LEVEL" ~doc ~docs [ "l"; "logs" ] in
+  Arg.(value & opt logs [] doc)
+
+(** {3 Blocks} *)
+
+let disk =
+  let doc =
+    Arg.info ~docs:s_disk
+      ~doc:
+        "Name of the docteur disk (for Solo5 targets, the name must contains \
+         only alpanumeric characters)."
+      [ "disk" ]
+  in
+  Arg.(value & opt string "disk" doc)
+
+let analyze =
+  let doc =
+    Arg.info ~docs:s_disk
+      ~doc:"Analyze at the boot time the given docteur disk." [ "analyze" ]
+  in
+  Arg.(value & opt bool true doc)
+
+(** {3 Initial delay} *)
+
+let delay =
+  let doc =
+    Arg.info ~docs:Cmdliner.Manpage.s_common_options
+      ~doc:"Delay n seconds before starting up" [ "delay" ]
+  in
+  Arg.(value & opt int 0 doc)
+
+(** {3 Name} *)
+
+let name_k =
+  let doc =
+    Arg.info ~docs:Cmdliner.Manpage.s_common_options
+      ~doc:
+        "Runtime name of the unikernel. Accessible with `Mirage_runtime.name` \
+         (), used for example by syslog"
+      ~absent:
+        "defaults to the configuration-time name (first argument to \
+         `Mirage.register`)"
+      [ "name" ]
+  in
+  Arg.(value & opt (some' string) None doc)
+
+let _name : string option ref = ref None
+let set_name s = _name := Some s
+
+let name =
+  let r = Functoria_runtime.register_arg name_k in
+  fun () ->
+    match (r (), !_name) with
+    | Some x, _ -> x
+    | None, Some x -> x
+    | None, None -> "no-name"
+
+(* Hooks *)
+
+let exit_hooks = ref []
+let enter_iter_hooks = ref []
+let leave_iter_hooks = ref []
+let run t = List.iter (fun f -> f ()) !t
+let add f t = t := f :: !t
+
+let run_exit_hooks () =
+  Lwt_list.iter_s
+    (fun hook -> Lwt.catch (fun () -> hook ()) (fun _ -> Lwt.return_unit))
+    !exit_hooks
+
+let run_enter_iter_hooks () = run enter_iter_hooks
+let run_leave_iter_hooks () = run leave_iter_hooks
+let at_exit f = add f exit_hooks
+let at_leave_iter f = add f leave_iter_hooks
+let at_enter_iter f = add f enter_iter_hooks
+
+let with_argv =
+  Functoria_runtime.with_argv
+    ~sections:
+      [
+        Manpage.s_arguments;
+        Manpage.s_options;
+        s_http;
+        s_ssh;
+        s_tls;
+        s_he;
+        s_dns;
+        s_net;
+        s_log;
+        s_disk;
+        s_ocaml;
+      ]
+
+let runtime_args = Functoria_runtime.runtime_args
+let register = Functoria_runtime.register_arg
+let register_arg = Functoria_runtime.register_arg
+let argument_error = Functoria_runtime.argument_error
+let help_version = Functoria_runtime.help_version

unikernel/duniverse/mirage/lib_runtime/mirage_runtime.mli

@@ -0,0 +1,154 @@
+(*
+ * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Cmdliner
+
+(** Mirage runtime utilities.
+
+    {e Release v4.10.3} *)
+
+(** {2 Log thresholds} *)
+
+type log_threshold = [ `All | `Src of string ] * Logs.level option
+(** The type for log threshold. A log level of [None] disables logging. *)
+
+val set_level : default:Logs.level option -> log_threshold list -> unit
+(** [set_level ~default l] set the log levels needed to have all of the log
+    sources appearing in [l] be used. *)
+
+val logs : log_threshold list Term.t
+(** [logs] is a command-liner term for setting the log_threshold. *)
+
+(** {2 Command-line converters} *)
+
+module Conv : sig
+  val log_threshold : log_threshold Cmdliner.Arg.conv
+  (** [log_threshold] converts log reporter threshold. *)
+end
+
+(** {2 Manpage sections} *)
+
+val s_net : string
+(** [s_net] is used for network options. *)
+
+val s_disk : string
+(** [s_disk] is used for disk options. *)
+
+val s_log : string
+(** [s_log] is used for logging and monitoring options. *)
+
+val s_he : string
+(** [s_he] is used for happy eyeballs options. *)
+
+val s_dns : string
+(** [s_dns] is used for DNS options. *)
+
+val s_ssh : string
+(** [s_ssh] is used for SSH options. *)
+
+val s_tls : string
+(** [s_tls] is used for TLS options. *)
+
+val s_http : string
+(** [s_http] is used for HTTP options. *)
+
+(** {2 Blocks} *)
+
+val disk : string Term.t
+val analyze : bool Term.t
+
+(** {2 Startup delay} *)
+
+val delay : int Term.t
+(** 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. *)
+
+(** {2 Name} *)
+
+val name_k : string option Term.t
+(** The name key. *)
+
+val name : unit -> string
+(** The current name of the unikernel. This is expected to be the same during
+    the lifetime of an unikernel (but there's no guarantee since it can be
+    modified). *)
+
+(** {2 Registering scheduler hooks} *)
+
+val at_exit : (unit -> unit Lwt.t) -> unit
+(** [at_exit hook] registers [hook], which will be executed before the unikernel
+    exits. The first hook registered will be executed last. *)
+
+val at_enter_iter : (unit -> unit) -> unit
+(** [at_enter_iter hook] registers [hook] to be executed at the beginning of
+    each event loop iteration. The first hook registered will be executed last.
+
+    If [hook] calls {!at_enter_iter} recursively, the new hook will run only on
+    the next event loop iteration. *)
+
+val at_leave_iter : (unit -> unit) -> unit
+(** [at_leave_iter hook] registers [hook] to be executed at the end of each
+    event loop iteration. See {!at_enter_iter} for details. *)
+
+(** {2 Running hooks} *)
+
+(** This is mainly for for developers implementing new targets. *)
+
+val run_exit_hooks : unit -> unit Lwt.t
+(** [run_exit_hooks ()] calls the sequence of hooks registered with {!at_exit}
+    in sequence. *)
+
+val run_enter_iter_hooks : unit -> unit
+(** [run_enter_iter_hooks ()] calls the sequence of hooks registered with
+    {!at_enter_iter} in sequence. *)
+
+val run_leave_iter_hooks : unit -> unit
+(** [run_leave_iter_hooks ()] call the sequence of hooks registered with
+    {!at_leave_iter} in sequence. *)
+
+(** {2 Exit Codes} *)
+
+val argument_error : int
+(** [argument_error] is the exit code used for argument parsing errors: 64. *)
+
+val help_version : int
+(** [help_version] is the exit code used when help/version is used: 63. *)
+
+(** {2 Runtime Arguments} *)
+
+val register_arg : 'a Cmdliner.Term.t -> (unit -> 'a)
+(* the return value is (unit -> 'a), let's keep the parens although they're
+   superfluous. *)
+[@@ocamlformat "disable"]
+(** [register_arg term] registers term to be evaluated at boot time. An example
+    is: [let hello = register_arg <myterm>] (at the toplevel of the unikernel),
+    and in the unikernel code
+    [Logs.info (fun m -> m "hello argument is: %s" (hello ()))]. *)
+
+(**/**)
+
+val with_argv : unit Cmdliner.Term.t list -> string -> string array -> unit
+val runtime_args : unit -> unit Cmdliner.Term.t list
+
+val register : 'a Cmdliner.Term.t -> (unit -> 'a)
+(* the return value is (unit -> 'a), let's keep the parens although they're
+   superfluous. *)
+[@@ocamlformat "disable"]
+[@@ocaml.deprecated "Use Mirage_runtime.register_arg instead."]
+
+val set_name : string -> unit
+(** Set the name of the unikernel, called at load time for the default name. *)

unikernel/duniverse/mirage/lib_runtime/mirage_runtime_network.ml

@@ -0,0 +1,192 @@
+open Cmdliner
+
+let pf = Format.fprintf
+let str = Format.asprintf
+
+let pp_group ppf = function
+  | None -> pf ppf "the unikernel"
+  | Some s -> pf ppf "the %s group" s
+
+let runtime_arg ?(group = "") ~docs ?docv ~doc ~default c name =
+  let prefix = if group = "" then group else group ^ "-" in
+  let doc = Arg.info ~docs ?docv ~doc [ prefix ^ name ] in
+  Arg.(value & opt c default doc)
+
+let interface ?group ?(docs = Mirage_runtime.s_net) default =
+  let doc = str "The network interface listened by %a." pp_group group in
+  runtime_arg ~doc ~default ?group ~docs ~docv:"INTERFACE" Arg.string
+    "interface"
+
+module Conv = struct
+  let conv of_string to_string : _ Cmdliner.Arg.conv =
+    let pp ppf v = Format.pp_print_string ppf (to_string v) in
+    Cmdliner.Arg.conv (of_string, pp)
+
+  let ipv4_address = conv Ipaddr.V4.of_string Ipaddr.V4.to_string
+  let ipv4 = conv Ipaddr.V4.Prefix.of_string Ipaddr.V4.Prefix.to_string
+  let ipv6_address = conv Ipaddr.V6.of_string Ipaddr.V6.to_string
+  let ipv6 = conv Ipaddr.V6.Prefix.of_string Ipaddr.V6.Prefix.to_string
+  let ip_address = conv Ipaddr.of_string Ipaddr.to_string
+end
+
+open Conv
+
+module V4 = struct
+  let network ?group ?(docs = Mirage_runtime.s_net) default =
+    let doc =
+      str
+        "The network of %a specified as an IP address and netmask, e.g. \
+         192.168.0.1/16 ."
+        pp_group group
+    in
+    runtime_arg ~doc ~docs ~docv:"PREFIX" ~default ?group ipv4 "ipv4"
+
+  let gateway ?group ?(docs = Mirage_runtime.s_net) default =
+    let doc = str "The gateway of %a." pp_group group in
+    runtime_arg ~doc ~docs ~docv:"IP" ~default ?group
+      Arg.(some ipv4_address)
+      "ipv4-gateway"
+end
+
+module V6 = struct
+  let network ?group ?(docs = Mirage_runtime.s_net) default =
+    let doc =
+      str "The network of %a specified as IPv6 address and prefix length."
+        pp_group group
+    in
+    runtime_arg ~doc ~docs ~docv:"PREFIX" ~default ?group Arg.(some ipv6) "ipv6"
+
+  let gateway ?group ?(docs = Mirage_runtime.s_net) default =
+    let doc = str "The gateway of %a." pp_group group in
+    runtime_arg ~doc ~docs ~docv:"IP" ~default ?group
+      Arg.(some ipv6_address)
+      "ipv6-gateway"
+
+  let accept_router_advertisements ?group ?(docs = Mirage_runtime.s_net) () =
+    let doc = str "Accept router advertisements for %a." pp_group group in
+    runtime_arg ~doc ~docs ?group ~default:true Arg.bool
+      "accept-router-advertisements"
+end
+
+let ipv4_only ?group ?(docs = Mirage_runtime.s_net) () =
+  let doc = str "Only use IPv4 for %a." pp_group group in
+  runtime_arg ~doc ~docs ?group ~default:false Arg.bool "ipv4-only"
+
+let ipv6_only ?group ?(docs = Mirage_runtime.s_net) () =
+  let doc = str "Only use IPv6 for %a." pp_group group in
+  runtime_arg ~doc ~docs ?group ~default:false Arg.bool "ipv6-only"
+
+let resolver ?group ?(docs = Mirage_runtime.s_net) ?default () =
+  let doc = str "DNS resolver (default to anycast.censurfridns.dk)" in
+  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
+    Arg.(some (list string))
+    "resolver"
+
+let dns_servers ?group ?(docs = Mirage_runtime.s_dns) default =
+  let doc = str "DNS servers (default to anycast.censurfridns.dk)" in
+  runtime_arg ~doc ~docv:"DNS-SERVER" ~docs ?group ~default
+    Arg.(some (list string))
+    "dns_servers"
+
+let dns_timeout ?group ?(docs = Mirage_runtime.s_dns) default =
+  let doc = str "DNS timeout (in nanoseconds)" in
+  runtime_arg ~doc ~docv:"DNS-TIMEOUT" ~docs ?group ~default
+    Arg.(some int64)
+    "dns_timeout"
+
+let dns_cache_size ?group ?(docs = Mirage_runtime.s_dns) default =
+  let doc = str "DNS cache size" in
+  runtime_arg ~doc ~docv:"DNS-CACHE-SIZE" ~docs ?group ~default
+    Arg.(some int)
+    "dns_cache_size"
+
+let he_aaaa_timeout ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "AAAA timeout (in nanoseconds)" in
+  runtime_arg ~doc ~docv:"AAAA-TIMEOUT" ~docs ?group ~default
+    Arg.(some int64)
+    "he_aaaa_timeout"
+
+let he_connect_delay ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "Delay (in nanoseconds) for connection establishment" in
+  runtime_arg ~doc ~docv:"CONNECT-DELAY" ~docs ?group ~default
+    Arg.(some int64)
+    "he_connect_delay"
+
+let he_connect_timeout ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "Connection establishment timeout (in nanoseconds)" in
+  runtime_arg ~doc ~docv:"CONNECT-TIMEOUT" ~docs ?group ~default
+    Arg.(some int64)
+    "he_connect_timeout"
+
+let he_resolve_timeout ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "DNS resolution timeout (in nanoseconds)" in
+  runtime_arg ~doc ~docv:"RESOLVE-TIMEOUT" ~docs ?group ~default
+    Arg.(some int64)
+    "he_resolve_timeout"
+
+let he_resolve_retries ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "Amount of DNS resolution attempts" in
+  runtime_arg ~doc ~docv:"RESOLVE-RETRIES" ~docs ?group ~default
+    Arg.(some int)
+    "he_resolve_retries"
+
+let he_timer_interval ?group ?(docs = Mirage_runtime.s_he) default =
+  let doc = str "Interal (in nanoseconds) for execution of the timer" in
+  runtime_arg ~doc ~docv:"TIMER-INTERVAL" ~docs ?group ~default
+    Arg.(some int64)
+    "he_timer_interval"
+
+let ssh_key ?group ?(docs = Mirage_runtime.s_ssh) default =
+  let doc = str "Private SSH key (rsa:<seed> or ed25519:<b64-key>)." in
+  runtime_arg ~doc ~docs ~docv:"KEY" ?group ~default Arg.(some string) "ssh-key"
+
+let ssh_password ?group ?(docs = Mirage_runtime.s_ssh) default =
+  let doc = str "Private SSH password." in
+  runtime_arg ~doc ~docs ~docv:"PASSWORD" ?group ~default
+    Arg.(some string)
+    "ssh-password"
+
+let ssh_authenticator ?group ?(docs = Mirage_runtime.s_ssh) default =
+  let doc = str "SSH authenticator." in
+  runtime_arg ~doc ~docs ~docv:"SSH-AUTHENTICATOR" ?group ~default
+    Arg.(some string)
+    "ssh-authenticator"
+
+let tls_authenticator ?group ?(docs = Mirage_runtime.s_tls) default =
+  let doc = str "TLS authenticator." in
+  runtime_arg ~doc ~docs ~docv:"TLS-AUTHENTICATOR" ?group ~default
+    Arg.(some string)
+    "tls-authenticator"
+
+let http_headers ?group ?(docs = Mirage_runtime.s_http) default =
+  let doc = str "HTTP headers." in
+  runtime_arg ~doc ~docs ~docv:"HEADERS" ?group ~default
+    Arg.(some (list ~sep:',' (pair ~sep:':' string string)))
+    "http-headers"
+
+let syslog ?group ?(docs = Mirage_runtime.s_log) default =
+  let doc = str "syslog server IP" in
+  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
+    Arg.(some ip_address)
+    "syslog"
+
+let syslog_port ?group ?(docs = Mirage_runtime.s_log) default =
+  let default = Option.value ~default:514 default in
+  let doc = str "syslog server port" in
+  runtime_arg ~doc ~docs ~docv:"PORT" ?group ~default Arg.int "syslog-port"
+
+let syslog_truncate ?group ?(docs = Mirage_runtime.s_log) default =
+  let doc = str "truncate syslog messages" in
+  runtime_arg ~doc ~docs ?group ~default Arg.(some int) "syslog-truncate"
+
+let syslog_keyname ?group ?(docs = Mirage_runtime.s_log) default =
+  let doc = str "TLS key name used for syslog" in
+  runtime_arg ~doc ~docs ?group ~default Arg.(some string) "syslog-keyname"
+
+let monitor ?group ?(docs = Mirage_runtime.s_log) default =
+  let doc = str "monitor server" in
+  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
+    Arg.(some ip_address)
+    "monitor"
+
+module Arg = Conv

unikernel/duniverse/mirage/lib_runtime/mirage_runtime_network.mli

@@ -0,0 +1,152 @@
+open Cmdliner
+
+(** {1 Command-line arguments for network devices} *)
+
+(** This module is the runtime counter-part of the network command-line
+    arguments defined in [Mirage_runtime_arg]. Both modules should be kept in
+    sync. *)
+
+val interface : ?group:string -> ?docs:string -> string -> string Term.t
+(** A network interface, [docs] defaults to {!Mirage_runtime.s_net}. *)
+
+(** [Cmdliner.Arg] converters for [Ipadrr] types. *)
+module Arg : sig
+  val ipv4_address : Ipaddr.V4.t Arg.conv
+  val ipv4 : Ipaddr.V4.Prefix.t Arg.conv
+  val ipv6_address : Ipaddr.V6.t Arg.conv
+  val ipv6 : Ipaddr.V6.Prefix.t Arg.conv
+  val ip_address : Ipaddr.t Arg.conv
+end
+
+(** Ipv4 Terms *)
+module V4 : sig
+  open Ipaddr.V4
+
+  val network : ?group:string -> ?docs:string -> Prefix.t -> Prefix.t Term.t
+  (** A network defined by an address and netmask, [docs] defaults to
+      {!Mirage_runtime.s_net}. *)
+
+  val gateway : ?group:string -> ?docs:string -> t option -> t option Term.t
+  (** A default gateway option, [docs] defaults to {!Mirage_runtime.s_net}. *)
+end
+
+(** Ipv6 Term.ts. *)
+module V6 : sig
+  open Ipaddr.V6
+
+  val network :
+    ?group:string -> ?docs:string -> Prefix.t option -> Prefix.t option Term.t
+  (** A network defined by an address and netmask, [docs] defaults to
+      {!Mirage_runtime.s_net}. *)
+
+  val gateway : ?group:string -> ?docs:string -> t option -> t option Term.t
+  (** A default gateway option, [docs] defaults to {!Mirage_runtime.s_net}. *)
+
+  val accept_router_advertisements :
+    ?group:string -> ?docs:string -> unit -> bool Term.t
+  (** An option whether to accept router advertisements, [docs] defaults to
+      {!Mirage_runtime.s_net}. *)
+end
+
+val ipv4_only : ?group:string -> ?docs:string -> unit -> bool Term.t
+(** An option for dual stack to only use IPv4, [docs] defaults to
+    {!Mirage_runtime.s_net}. *)
+
+val ipv6_only : ?group:string -> ?docs:string -> unit -> bool Term.t
+(** An option for dual stack to only use IPv6, [docs] defaults to
+    {!Mirage_runtime.s_net}. *)
+
+val resolver :
+  ?group:string ->
+  ?docs:string ->
+  ?default:string list ->
+  unit ->
+  string list option Term.t
+(** The address of the DNS resolver to use. See $REFERENCE for format. [docs]
+    defaults to {!Mirage_runtime.s_net}. *)
+
+val dns_servers :
+  ?group:string ->
+  ?docs:string ->
+  string list option ->
+  string list option Term.t
+(** The address of the DNS servers to use. See $REFERENCE for format. [docs]
+    defaults to {!Mirage_runtime.s_net}. *)
+
+val dns_timeout :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The timeout (in nanoseconds) for DNS resolution. *)
+
+val dns_cache_size :
+  ?group:string -> ?docs:string -> int option -> int option Term.t
+(** The DNS resolution cache size. *)
+
+val he_aaaa_timeout :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The timeout (in nanoseconds) for AAAA resolution. *)
+
+val he_connect_delay :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The delay (in nanoseconds) for establishing connections. *)
+
+val he_connect_timeout :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The timeout (in nanoseconds) for establishing connections. *)
+
+val he_resolve_timeout :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The timeout (in nanoseconds) for DNS resolution. *)
+
+val he_resolve_retries :
+  ?group:string -> ?docs:string -> int option -> int option Term.t
+(** The number of DNS resolution attempts. *)
+
+val he_timer_interval :
+  ?group:string -> ?docs:string -> int64 option -> int64 option Term.t
+(** The interval (in nanoseconds) when the timer is executed. *)
+
+val ssh_key :
+  ?group:string -> ?docs:string -> string option -> string option Term.t
+(** The private SSH key. *)
+
+val ssh_password :
+  ?group:string -> ?docs:string -> string option -> string option Term.t
+(** The SSH password. *)
+
+val ssh_authenticator :
+  ?group:string -> ?docs:string -> string option -> string option Term.t
+(** The SSH authenticator. *)
+
+val tls_authenticator :
+  ?group:string -> ?docs:string -> string option -> string option Term.t
+(** The TLS authenticator. *)
+
+val http_headers :
+  ?group:string ->
+  ?docs:string ->
+  (string * string) list option ->
+  (string * string) list option Term.t
+(** HTTP headers. *)
+
+val syslog :
+  ?group:string -> ?docs:string -> Ipaddr.t option -> Ipaddr.t option Term.t
+(** The address to send syslog frames to, [docs] defaults to
+    {!Mirage_runtime.s_log}. *)
+
+val syslog_port : ?group:string -> ?docs:string -> int option -> int Term.t
+(** The port to send syslog frames to, [docs] defaults to
+    {!Mirage_runtime.s_log}. *)
+
+val syslog_truncate :
+  ?group:string -> ?docs:string -> int option -> int option Term.t
+(** Truncate syslog frames to a specific byte count, [docs] defaults to
+    {!Mirage_runtime.s_log}. *)
+
+val syslog_keyname :
+  ?group:string -> ?docs:string -> string option -> string option Term.t
+(** TLS key used for syslog, [docs] defaults to {!Mirage_runtime.s_log}. *)
+
+val monitor :
+  ?group:string -> ?docs:string -> Ipaddr.t option -> Ipaddr.t option Term.t
+(** The address to send monitor statistics to, [docs] defaults to
+    {!Mirage_runtime.s_log}. *)