156 lines
4.6 KiB
OCaml
156 lines
4.6 KiB
OCaml
(*
|
|
* 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.
|
|
*)
|
|
|
|
module Action = Functoria.Action
|
|
module Key = Functoria.Key
|
|
|
|
(** {2 Documentation helper} *)
|
|
|
|
let mirage_section = "MIRAGE PARAMETERS"
|
|
let unikernel_section = "UNIKERNEL PARAMETERS"
|
|
let pp_group = Fmt.(option ~none:(any "the unikernel") @@ fmt "the %s group")
|
|
|
|
(** {2 Special keys} *)
|
|
|
|
(** {3 Mode} *)
|
|
|
|
type mode_unix = [ `Unix | `MacOSX ]
|
|
type mode_xen = [ `Xen | `Qubes ]
|
|
type mode_solo5 = [ `Hvt | `Spt | `Virtio | `Muen | `Genode ]
|
|
type mode_unikraft = [ `Firecracker | `QEMU ]
|
|
type mode = [ mode_unix | mode_xen | mode_solo5 | mode_unikraft ]
|
|
|
|
let (target_conv : mode Cmdliner.Arg.conv), target_doc_alts =
|
|
let enum =
|
|
[
|
|
("unix", `Unix);
|
|
("macosx", `MacOSX);
|
|
("xen", `Xen);
|
|
("virtio", `Virtio);
|
|
("hvt", `Hvt);
|
|
("muen", `Muen);
|
|
("qubes", `Qubes);
|
|
("genode", `Genode);
|
|
("spt", `Spt);
|
|
("unikraft-firecracker", `Firecracker);
|
|
("unikraft-qemu", `QEMU);
|
|
]
|
|
in
|
|
let conv = Cmdliner.Arg.enum enum in
|
|
(conv, Cmdliner.Arg.doc_alts_enum enum)
|
|
|
|
let pp_target fmt m = Cmdliner.Arg.conv_printer target_conv fmt m
|
|
|
|
let default_target =
|
|
match Sys.getenv "MIRAGE_DEFAULT_TARGET" with
|
|
| "unix" -> `Unix
|
|
| s -> Fmt.failwith "invalid default target: %S" s
|
|
| exception Not_found -> (
|
|
match Action.run @@ Action.run_cmd_out Bos.Cmd.(v "uname" % "-s") with
|
|
| Ok "Darwin" -> `MacOSX
|
|
| _ -> `Unix)
|
|
|
|
let target =
|
|
let doc =
|
|
Fmt.str "Target platform to compile the unikernel for. Valid values are: %s"
|
|
target_doc_alts
|
|
in
|
|
let doc =
|
|
Cmdliner.Arg.info ~docs:mirage_section ~docv:"TARGET" ~doc [ "t"; "target" ]
|
|
~env:(Cmdliner.Cmd.Env.info "MODE")
|
|
in
|
|
let key = Key.Arg.opt target_conv default_target doc in
|
|
Key.create "target" key
|
|
|
|
let is_unix =
|
|
Key.match_ Key.(value target) @@ function
|
|
| #mode_unix -> true
|
|
| #mode_xen | #mode_solo5 | #mode_unikraft -> false
|
|
|
|
let is_solo5 =
|
|
Key.match_ Key.(value target) @@ function
|
|
| #mode_solo5 -> true
|
|
| #mode_xen | #mode_unix | #mode_unikraft -> false
|
|
|
|
let is_xen =
|
|
Key.match_ Key.(value target) @@ function
|
|
| #mode_xen -> true
|
|
| #mode_solo5 | #mode_unix | #mode_unikraft -> false
|
|
|
|
let is_unikraft =
|
|
Key.match_ Key.(value target) @@ function
|
|
| #mode_unikraft -> true
|
|
| #mode_solo5 | #mode_unix | #mode_xen -> false
|
|
|
|
(** {2 General mirage keys} *)
|
|
|
|
let configure_key ?(group = "") ~doc ~default conv name =
|
|
let prefix = if group = "" then group else group ^ "-" in
|
|
let doc =
|
|
Cmdliner.Arg.info ~docs:unikernel_section
|
|
~docv:(String.uppercase_ascii name)
|
|
~doc
|
|
[ prefix ^ name ]
|
|
in
|
|
let key = Key.Arg.opt conv default doc in
|
|
Key.create (prefix ^ name) key
|
|
|
|
(** {3 File system keys} *)
|
|
|
|
let kv_ro ?group () =
|
|
let enum = [ ("crunch", `Crunch); ("direct", `Direct) ] in
|
|
let conv = Cmdliner.Arg.enum enum in
|
|
let doc =
|
|
Fmt.str "Use %s pass-through implementation for %a."
|
|
(Cmdliner.Arg.doc_alts_enum enum)
|
|
pp_group group
|
|
in
|
|
configure_key ~doc ?group ~default:`Crunch conv "kv_ro"
|
|
|
|
(** {3 Block device keys} *)
|
|
let block ?group () =
|
|
let enum =
|
|
[ ("xenstore", `XenstoreId); ("file", `BlockFile); ("ramdisk", `Ramdisk) ]
|
|
in
|
|
let conv = Cmdliner.Arg.enum enum in
|
|
let doc =
|
|
Fmt.str "Use %s pass-through implementation for %a."
|
|
(Cmdliner.Arg.doc_alts_enum enum)
|
|
pp_group group
|
|
in
|
|
configure_key ~doc ?group ~default:`Ramdisk conv "block"
|
|
|
|
(** {3 Stack keys} *)
|
|
|
|
let dhcp ?group () =
|
|
let doc = Fmt.str "Enable dhcp for %a." pp_group group in
|
|
configure_key ~doc ?group ~default:false Cmdliner.Arg.bool "dhcp"
|
|
|
|
let net ?group () : [ `Host | `OCaml ] option Key.key =
|
|
let enum =
|
|
[
|
|
("host", `Host); ("socket", `Host); ("direct", `OCaml); ("ocaml", `OCaml);
|
|
]
|
|
in
|
|
let conv = Cmdliner.Arg.enum enum in
|
|
let doc =
|
|
Fmt.str "Use %s group for %a."
|
|
(Cmdliner.Arg.doc_alts_enum enum)
|
|
pp_group group
|
|
in
|
|
configure_key ~doc ?group ~default:None (Cmdliner.Arg.some conv) "net"
|
|
|
|
include Key
|