albatross/provision/albatross_provision_request.ml

211 lines
6.3 KiB
OCaml
Raw Normal View History

2018-10-28 21:14:39 +00:00
(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
2017-05-26 14:30:34 +00:00
2019-03-27 23:11:43 +00:00
open Albatross_provision
2018-10-28 21:14:39 +00:00
open Vmm_asn
2018-10-25 14:55:54 +00:00
open Rresult.R.Infix
2018-10-28 21:14:39 +00:00
let csr priv name cmd =
let ext =
let v = to_cert_extension cmd in
X509.Extension.(singleton (Unsupported oid) (false, v))
2019-10-06 21:38:13 +00:00
and name =
[ X509.Distinguished_name.(Relative_distinguished_name.singleton (CN name)) ]
2018-10-25 14:55:54 +00:00
in
let extensions = X509.Signing_request.Ext.(singleton Extensions ext) in
X509.Signing_request.create name ~extensions priv
2018-10-25 14:55:54 +00:00
2018-10-28 21:14:39 +00:00
let jump id cmd =
2020-03-13 15:24:52 +00:00
Mirage_crypto_rng_unix.initialize () ;
let name = Vmm_core.Name.to_string id in
priv_key None name >>= fun priv ->
let csr = csr priv name cmd in
let enc = X509.Signing_request.encode_pem csr in
Bos.OS.File.write Fpath.(v name + ".req") (Cstruct.to_string enc)
2018-10-25 14:55:54 +00:00
2018-10-28 21:14:39 +00:00
let info_policy _ name =
jump name (`Policy_cmd `Policy_info)
2017-05-26 14:30:34 +00:00
2018-10-28 21:14:39 +00:00
let remove_policy _ name =
jump name (`Policy_cmd `Policy_remove)
2017-05-26 14:30:34 +00:00
2018-10-28 21:14:39 +00:00
let add_policy _ name vms memory cpus block bridges =
2019-03-27 23:11:43 +00:00
let p = Albatross_cli.policy vms memory cpus block bridges in
2018-10-28 21:14:39 +00:00
jump name (`Policy_cmd (`Policy_add p))
2017-05-26 14:30:34 +00:00
2018-11-13 00:02:05 +00:00
let info_ _ name = jump name (`Unikernel_cmd `Unikernel_info)
2018-10-28 21:14:39 +00:00
let destroy _ name =
2018-11-13 00:02:05 +00:00
jump name (`Unikernel_cmd `Unikernel_destroy)
2017-05-26 14:30:34 +00:00
let create _ force name image cpuid memory argv block network compression restart_on_fail exit_code =
match Albatross_cli.create_vm force image cpuid memory argv block network compression restart_on_fail exit_code with
2018-11-13 00:02:05 +00:00
| Ok cmd -> jump name (`Unikernel_cmd cmd)
| Error (`Msg msg) -> Error (`Msg msg)
2017-05-26 14:30:34 +00:00
let console _ name since count =
jump name (`Console_cmd (`Console_subscribe (Albatross_cli.since_count since count)))
2017-05-26 14:30:34 +00:00
2018-10-28 21:14:39 +00:00
let stats _ name =
jump name (`Stats_cmd `Stats_subscribe)
2017-05-26 14:30:34 +00:00
let event_log _ name since count =
jump name (`Log_cmd (`Log_subscribe (Albatross_cli.since_count since count)))
2017-05-26 14:30:34 +00:00
2018-11-10 00:02:07 +00:00
let block_info _ block_name =
jump block_name (`Block_cmd `Block_info)
let block_create _ block_name block_size =
jump block_name (`Block_cmd (`Block_add block_size))
let block_destroy _ block_name =
jump block_name (`Block_cmd `Block_remove)
2018-10-28 21:14:39 +00:00
let help _ man_format cmds = function
| None -> `Help (`Pager, None)
| Some t when List.mem t cmds -> `Help (man_format, Some t)
| Some _ -> List.iter print_endline cmds; `Ok ()
2017-05-26 14:30:34 +00:00
2018-10-28 00:03:27 +00:00
open Cmdliner
2019-03-27 23:11:43 +00:00
open Albatross_cli
2018-10-28 00:03:27 +00:00
2018-10-28 21:14:39 +00:00
let destroy_cmd =
let doc = "destroys a virtual machine" in
let man =
[`S "DESCRIPTION";
`P "Destroy a virtual machine."]
in
Term.(term_result (const destroy $ setup_log $ vm_name)),
2018-10-28 21:14:39 +00:00
Term.info "destroy" ~doc ~man
let remove_policy_cmd =
let doc = "removes a policy" in
let man =
[`S "DESCRIPTION";
`P "Removes a policy."]
in
Term.(term_result (const remove_policy $ setup_log $ opt_vm_name)),
2018-10-28 21:14:39 +00:00
Term.info "remove_policy" ~doc ~man
let info_cmd =
let doc = "information about VMs" in
let man =
[`S "DESCRIPTION";
`P "Shows information about VMs."]
in
Term.(term_result (const info_ $ setup_log $ opt_vm_name)),
2018-10-28 21:14:39 +00:00
Term.info "info" ~doc ~man
let policy_cmd =
let doc = "active policies" in
let man =
[`S "DESCRIPTION";
`P "Shows information about policies."]
in
Term.(term_result (const info_policy $ setup_log $ opt_vm_name)),
2018-10-28 21:14:39 +00:00
Term.info "policy" ~doc ~man
let add_policy_cmd =
let doc = "Add a policy" in
let man =
[`S "DESCRIPTION";
`P "Adds a policy."]
in
Term.(term_result (const add_policy $ setup_log $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)),
2018-10-28 21:14:39 +00:00
Term.info "add_policy" ~doc ~man
let create_cmd =
let doc = "creates a virtual machine" in
let man =
[`S "DESCRIPTION";
`P "Creates a virtual machine."]
in
Term.(term_result (const create $ setup_log $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level 9 $ restart_on_fail $ exit_code)),
2018-10-28 21:14:39 +00:00
Term.info "create" ~doc ~man
let console_cmd =
let doc = "console of a VM" in
let man =
[`S "DESCRIPTION";
`P "Shows console output of a VM."]
in
Term.(term_result (const console $ setup_log $ vm_name $ since $ count)),
2018-10-28 21:14:39 +00:00
Term.info "console" ~doc ~man
let stats_cmd =
let doc = "statistics of VMs" in
let man =
[`S "DESCRIPTION";
`P "Shows statistics of VMs."]
in
Term.(term_result (const stats $ setup_log $ opt_vm_name)),
2018-10-28 21:14:39 +00:00
Term.info "stats" ~doc ~man
let log_cmd =
let doc = "Event log" in
let man =
[`S "DESCRIPTION";
`P "Shows event log of VM."]
in
Term.(term_result (const event_log $ setup_log $ opt_vm_name $ since $ count)),
2018-10-28 21:14:39 +00:00
Term.info "log" ~doc ~man
2018-10-28 00:03:27 +00:00
2018-11-10 00:02:07 +00:00
let block_info_cmd =
let doc = "Information about block devices" in
let man =
[`S "DESCRIPTION";
`P "Block device information."]
in
Term.(term_result (const block_info $ setup_log $ opt_block_name)),
2018-11-10 00:02:07 +00:00
Term.info "block" ~doc ~man
let block_create_cmd =
let doc = "Create a block device" in
let man =
[`S "DESCRIPTION";
`P "Creation of a block device."]
in
Term.(term_result (const block_create $ setup_log $ block_name $ block_size)),
2018-11-10 00:02:07 +00:00
Term.info "create_block" ~doc ~man
let block_destroy_cmd =
let doc = "Destroys a block device" in
let man =
[`S "DESCRIPTION";
`P "Destroys a block device."]
in
Term.(term_result (const block_destroy $ setup_log $ block_name)),
2018-11-10 00:02:07 +00:00
Term.info "destroy_block" ~doc ~man
2018-10-28 21:14:39 +00:00
let help_cmd =
let topic =
let doc = "The topic to get help on. `topics' lists the topics." in
Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc)
in
2019-03-27 23:11:43 +00:00
let doc = "display help about albatross provision request" in
2018-10-28 21:14:39 +00:00
let man =
[`S "DESCRIPTION";
2019-03-27 23:11:43 +00:00
`P "Prints help about albatross provision request commands and subcommands"]
2018-10-28 21:14:39 +00:00
in
Term.(ret (const help $ setup_log $ Term.man_format $ Term.choice_names $ topic)),
Term.info "help" ~doc ~man
let default_cmd =
2019-03-27 23:11:43 +00:00
let doc = "Albatross provisioning request" in
2018-10-28 21:14:39 +00:00
let man = [
`S "DESCRIPTION" ;
2019-03-27 23:11:43 +00:00
`P "$(tname) creates a certificate signing request for Albatross" ]
2018-10-28 21:14:39 +00:00
in
Term.(ret (const help $ setup_log $ Term.man_format $ Term.choice_names $ Term.pure None)),
Term.info "albatross_provision_request" ~version ~doc ~man
2018-10-28 00:03:27 +00:00
2018-11-10 00:02:07 +00:00
let cmds = [ help_cmd ; info_cmd ;
policy_cmd ; remove_policy_cmd ; add_policy_cmd ;
destroy_cmd ; create_cmd ;
block_info_cmd ; block_create_cmd ; block_destroy_cmd ;
console_cmd ; stats_cmd ; log_cmd ]
2018-10-28 00:03:27 +00:00
2018-10-28 21:14:39 +00:00
let () =
match Term.eval_choice default_cmd cmds
with `Ok () -> exit 0 | _ -> exit 1