From 95a46638fae1ed56794d047d1099748fc74b6196 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 8 Apr 2019 16:40:58 +0200 Subject: [PATCH] use cmdliner.1.0.0, especially term_result move albatross_cli to a custom directory (command-line) --- albatross.opam | 2 +- client/albatross_client_bistro.ml | 28 +++++++-------- client/albatross_client_local.ml | 32 ++++++++--------- {daemon => command-line}/albatross_cli.ml | 0 command-line/dune | 6 ++++ daemon/albatross_console.ml | 2 +- daemon/albatross_log.ml | 2 +- daemon/dune | 7 ---- provision/albatross_provision_ca.ml | 42 +++++++++-------------- provision/albatross_provision_request.ml | 38 +++++++++----------- stats/albatross_stat_client.ml | 2 +- stats/albatross_stats.ml | 2 +- tls/albatross_tls_endpoint.ml | 2 +- tls/albatross_tls_inetd.ml | 5 ++- 14 files changed, 78 insertions(+), 92 deletions(-) rename {daemon => command-line}/albatross_cli.ml (100%) create mode 100644 command-line/dune diff --git a/albatross.opam b/albatross.opam index 3a83c72..3197c63 100644 --- a/albatross.opam +++ b/albatross.opam @@ -16,7 +16,7 @@ depends: [ "rresult" "bos" "ptime" - "cmdliner" + "cmdliner" {>= "1.0.0"} "fmt" "astring" "x509" {>= "0.6.0"} diff --git a/client/albatross_client_bistro.ml b/client/albatross_client_bistro.ml index a6568ae..02224d4 100644 --- a/client/albatross_client_bistro.ml +++ b/client/albatross_client_bistro.ml @@ -67,7 +67,7 @@ let handle (host, port) cert key ca id (cmd : Vmm_commands.t) = read t let jump endp cert key ca name cmd = - `Ok (Lwt_main.run (handle endp cert key ca name cmd)) + Ok (Lwt_main.run (handle endp cert key ca name cmd)) let info_policy _ endp cert key ca name = jump endp cert key ca name (`Policy_cmd `Policy_info) @@ -88,7 +88,7 @@ let destroy _ endp cert key ca name = let create _ endp cert key ca force name image cpuid memory argv block network compression = match Albatross_cli.create_vm force image cpuid memory argv block network compression with | Ok cmd -> jump endp cert key ca name (`Unikernel_cmd cmd) - | Error (`Msg msg) -> `Error (false, msg) + | Error (`Msg msg) -> Error (`Msg msg) let console _ endp cert key ca name since = jump endp cert key ca name (`Console_cmd (`Console_subscribe since)) @@ -138,7 +138,7 @@ let destroy_cmd = [`S "DESCRIPTION"; `P "Destroy a virtual machine."] in - Term.(ret (const destroy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name)), + Term.(term_result (const destroy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name)), Term.info "destroy" ~doc ~man let remove_policy_cmd = @@ -147,7 +147,7 @@ let remove_policy_cmd = [`S "DESCRIPTION"; `P "Removes a policy."] in - Term.(ret (const remove_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), + Term.(term_result (const remove_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), Term.info "remove_policy" ~doc ~man let info_cmd = @@ -156,7 +156,7 @@ let info_cmd = [`S "DESCRIPTION"; `P "Shows information about VMs."] in - Term.(ret (const info_ $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), + Term.(term_result (const info_ $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), Term.info "info" ~doc ~man let policy_cmd = @@ -165,7 +165,7 @@ let policy_cmd = [`S "DESCRIPTION"; `P "Shows information about policies."] in - Term.(ret (const info_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), + Term.(term_result (const info_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), Term.info "policy" ~doc ~man let add_policy_cmd = @@ -174,7 +174,7 @@ let add_policy_cmd = [`S "DESCRIPTION"; `P "Adds a policy."] in - Term.(ret (const add_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), + Term.(term_result (const add_policy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), Term.info "add_policy" ~doc ~man let create_cmd = @@ -183,7 +183,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), + Term.(term_result (const create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = @@ -192,7 +192,7 @@ let console_cmd = [`S "DESCRIPTION"; `P "Shows console output of a VM."] in - Term.(ret (const console $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name $ since)), + Term.(term_result (const console $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name $ since)), Term.info "console" ~doc ~man let stats_cmd = @@ -201,7 +201,7 @@ let stats_cmd = [`S "DESCRIPTION"; `P "Shows statistics of VMs."] in - Term.(ret (const stats $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), + Term.(term_result (const stats $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name)), Term.info "stats" ~doc ~man let log_cmd = @@ -210,7 +210,7 @@ let log_cmd = [`S "DESCRIPTION"; `P "Shows event log of VM."] in - Term.(ret (const event_log $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name $ since)), + Term.(term_result (const event_log $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name $ since)), Term.info "log" ~doc ~man let block_info_cmd = @@ -219,7 +219,7 @@ let block_info_cmd = [`S "DESCRIPTION"; `P "Block device information."] in - Term.(ret (const block_info $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_block_name)), + Term.(term_result (const block_info $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_block_name)), Term.info "block" ~doc ~man let block_create_cmd = @@ -228,7 +228,7 @@ let block_create_cmd = [`S "DESCRIPTION"; `P "Creation of a block device."] in - Term.(ret (const block_create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ block_name $ block_size)), + Term.(term_result (const block_create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ block_name $ block_size)), Term.info "create_block" ~doc ~man let block_destroy_cmd = @@ -237,7 +237,7 @@ let block_destroy_cmd = [`S "DESCRIPTION"; `P "Destroys a block device."] in - Term.(ret (const block_destroy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ block_name)), + Term.(term_result (const block_destroy $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ block_name)), Term.info "destroy_block" ~doc ~man let help_cmd = diff --git a/client/albatross_client_local.ml b/client/albatross_client_local.ml index 5c1dabe..1593b6e 100644 --- a/client/albatross_client_local.ml +++ b/client/albatross_client_local.ml @@ -41,7 +41,7 @@ let handle opt_socket name (cmd : Vmm_commands.t) = Vmm_lwt.safe_close fd let jump opt_socket name cmd = - `Ok (Lwt_main.run (handle opt_socket name cmd)) + Ok (Lwt_main.run (handle opt_socket name cmd)) let info_policy _ opt_socket name = jump opt_socket name (`Policy_cmd `Policy_info) @@ -62,7 +62,7 @@ let destroy _ opt_socket name = let create _ opt_socket force name image cpuid memory argv block network compression = match Albatross_cli.create_vm force image cpuid memory argv block network compression with | Ok cmd -> jump opt_socket name (`Unikernel_cmd cmd) - | Error (`Msg msg) -> `Error (false, msg) + | Error (`Msg msg) -> Error (`Msg msg) let console _ opt_socket name since = jump opt_socket name (`Console_cmd (`Console_subscribe since)) @@ -106,7 +106,7 @@ let destroy_cmd = [`S "DESCRIPTION"; `P "Destroy a virtual machine."] in - Term.(ret (const destroy $ setup_log $ socket $ vm_name)), + Term.(term_result (const destroy $ setup_log $ socket $ vm_name)), Term.info "destroy" ~doc ~man let remove_policy_cmd = @@ -115,7 +115,7 @@ let remove_policy_cmd = [`S "DESCRIPTION"; `P "Removes a policy."] in - Term.(ret (const remove_policy $ setup_log $ socket $ opt_vm_name)), + Term.(term_result (const remove_policy $ setup_log $ socket $ opt_vm_name)), Term.info "remove_policy" ~doc ~man let info_cmd = @@ -124,7 +124,7 @@ let info_cmd = [`S "DESCRIPTION"; `P "Shows information about VMs."] in - Term.(ret (const info_ $ setup_log $ socket $ opt_vm_name)), + Term.(term_result (const info_ $ setup_log $ socket $ opt_vm_name)), Term.info "info" ~doc ~man let policy_cmd = @@ -133,7 +133,7 @@ let policy_cmd = [`S "DESCRIPTION"; `P "Shows information about policies."] in - Term.(ret (const info_policy $ setup_log $ socket $ opt_vm_name)), + Term.(term_result (const info_policy $ setup_log $ socket $ opt_vm_name)), Term.info "policy" ~doc ~man let add_policy_cmd = @@ -142,7 +142,7 @@ let add_policy_cmd = [`S "DESCRIPTION"; `P "Adds a policy."] in - Term.(ret (const add_policy $ setup_log $ socket $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), + Term.(term_result (const add_policy $ setup_log $ socket $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), Term.info "add_policy" ~doc ~man let create_cmd = @@ -151,7 +151,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ socket $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), + Term.(term_result (const create $ setup_log $ socket $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = @@ -160,7 +160,7 @@ let console_cmd = [`S "DESCRIPTION"; `P "Shows console output of a VM."] in - Term.(ret (const console $ setup_log $ socket $ vm_name $ since)), + Term.(term_result (const console $ setup_log $ socket $ vm_name $ since)), Term.info "console" ~doc ~man let stats_subscribe_cmd = @@ -169,7 +169,7 @@ let stats_subscribe_cmd = [`S "DESCRIPTION"; `P "Shows statistics of VMs."] in - Term.(ret (const stats_subscribe $ setup_log $ socket $ opt_vm_name)), + Term.(term_result (const stats_subscribe $ setup_log $ socket $ opt_vm_name)), Term.info "stats" ~doc ~man let stats_remove_cmd = @@ -178,7 +178,7 @@ let stats_remove_cmd = [`S "DESCRIPTION"; `P "Removes statistics of VM."] in - Term.(ret (const stats_remove $ setup_log $ socket $ opt_vm_name)), + Term.(term_result (const stats_remove $ setup_log $ socket $ opt_vm_name)), Term.info "stats_remove" ~doc ~man let stats_add_cmd = @@ -187,7 +187,7 @@ let stats_add_cmd = [`S "DESCRIPTION"; `P "Add VM to statistics gathering."] in - Term.(ret (const stats_add $ setup_log $ socket $ opt_vm_name $ vmm_dev_req0 $ pid_req1 $ bridge_taps)), + Term.(term_result (const stats_add $ setup_log $ socket $ opt_vm_name $ vmm_dev_req0 $ pid_req1 $ bridge_taps)), Term.info "stats_add" ~doc ~man let log_cmd = @@ -196,7 +196,7 @@ let log_cmd = [`S "DESCRIPTION"; `P "Shows event log of VM."] in - Term.(ret (const event_log $ setup_log $ socket $ opt_vm_name $ since)), + Term.(term_result (const event_log $ setup_log $ socket $ opt_vm_name $ since)), Term.info "log" ~doc ~man let block_info_cmd = @@ -205,7 +205,7 @@ let block_info_cmd = [`S "DESCRIPTION"; `P "Block device information."] in - Term.(ret (const block_info $ setup_log $ socket $ opt_block_name)), + Term.(term_result (const block_info $ setup_log $ socket $ opt_block_name)), Term.info "block" ~doc ~man let block_create_cmd = @@ -214,7 +214,7 @@ let block_create_cmd = [`S "DESCRIPTION"; `P "Creation of a block device."] in - Term.(ret (const block_create $ setup_log $ socket $ block_name $ block_size)), + Term.(term_result (const block_create $ setup_log $ socket $ block_name $ block_size)), Term.info "create_block" ~doc ~man let block_destroy_cmd = @@ -223,7 +223,7 @@ let block_destroy_cmd = [`S "DESCRIPTION"; `P "Destroys a block device."] in - Term.(ret (const block_destroy $ setup_log $ socket $ block_name)), + Term.(term_result (const block_destroy $ setup_log $ socket $ block_name)), Term.info "destroy_block" ~doc ~man let help_cmd = diff --git a/daemon/albatross_cli.ml b/command-line/albatross_cli.ml similarity index 100% rename from daemon/albatross_cli.ml rename to command-line/albatross_cli.ml diff --git a/command-line/dune b/command-line/dune new file mode 100644 index 0000000..d02cf35 --- /dev/null +++ b/command-line/dune @@ -0,0 +1,6 @@ +(library + (name albatross_cli) + (public_name albatross.cli) + (wrapped false) + (modules albatross_cli) + (libraries checkseum.c albatross lwt.unix cmdliner logs.fmt logs.cli fmt.cli fmt.tty ipaddr.unix)) diff --git a/daemon/albatross_console.ml b/daemon/albatross_console.ml index fd6f0d2..c37d6f2 100644 --- a/daemon/albatross_console.ml +++ b/daemon/albatross_console.ml @@ -181,7 +181,7 @@ let socket = Arg.(value & opt string (Vmm_core.socket_path `Console) & info [ "socket" ] ~doc) let cmd = - Term.(ret (const jump $ setup_log $ socket)), + Term.(term_result (const jump $ setup_log $ socket)), Term.info "albatross_console" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 diff --git a/daemon/albatross_log.ml b/daemon/albatross_log.ml index b0f0901..f108dec 100644 --- a/daemon/albatross_log.ml +++ b/daemon/albatross_log.ml @@ -198,7 +198,7 @@ let file = Arg.(value & opt string "/var/log/albatross" & info [ "logfile" ] ~doc) let cmd = - Term.(ret (const jump $ setup_log $ file $ socket)), + Term.(term_result (const jump $ setup_log $ file $ socket)), Term.info "albatross_log" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 diff --git a/daemon/dune b/daemon/dune index 65ace09..3f94d9f 100644 --- a/daemon/dune +++ b/daemon/dune @@ -1,10 +1,3 @@ -(library - (name albatross_cli) - (public_name albatross.cli) - (wrapped false) - (modules albatross_cli) - (libraries checkseum.c albatross lwt.unix cmdliner logs.fmt logs.cli fmt.cli fmt.tty ipaddr.unix)) - (executable (name albatrossd) (public_name albatrossd) diff --git a/provision/albatross_provision_ca.ml b/provision/albatross_provision_ca.ml index b51d2a0..56cc5da 100644 --- a/provision/albatross_provision_ca.ml +++ b/provision/albatross_provision_ca.ml @@ -58,17 +58,13 @@ let sign_csr dbname cacert key csr days = let sign _ db cacert cakey csrname days = Nocrypto_entropy_unix.initialize () ; - match - Bos.OS.File.read (Fpath.v cacert) >>= fun cacert -> - let cacert = X509.Encoding.Pem.Certificate.of_pem_cstruct1 (Cstruct.of_string cacert) in - Bos.OS.File.read (Fpath.v cakey) >>= fun pk -> - let cakey = X509.Encoding.Pem.Private_key.of_pem_cstruct1 (Cstruct.of_string pk) in - Bos.OS.File.read (Fpath.v csrname) >>= fun enc -> - let csr = X509.Encoding.Pem.Certificate_signing_request.of_pem_cstruct1 (Cstruct.of_string enc) in - sign_csr (Fpath.v db) cacert cakey csr days - with - | Ok () -> `Ok () - | Error (`Msg e) -> `Error (false, e) + Bos.OS.File.read (Fpath.v cacert) >>= fun cacert -> + let cacert = X509.Encoding.Pem.Certificate.of_pem_cstruct1 (Cstruct.of_string cacert) in + Bos.OS.File.read (Fpath.v cakey) >>= fun pk -> + let cakey = X509.Encoding.Pem.Private_key.of_pem_cstruct1 (Cstruct.of_string pk) in + Bos.OS.File.read (Fpath.v csrname) >>= fun enc -> + let csr = X509.Encoding.Pem.Certificate_signing_request.of_pem_cstruct1 (Cstruct.of_string enc) in + sign_csr (Fpath.v db) cacert cakey csr days let help _ man_format cmds = function | None -> `Help (`Pager, None) @@ -77,18 +73,14 @@ let help _ man_format cmds = function let generate _ name db days sname sdays = Nocrypto_entropy_unix.initialize () ; - match - Albatross_provision.priv_key ~bits:4096 None name >>= fun key -> - let name = [ `CN name ] in - let csr = X509.CA.request name key in - Albatross_provision.sign ~certname:"cacert" (d_exts ()) name key csr (Duration.of_day days) >>= fun () -> - Albatross_provision.priv_key None sname >>= fun skey -> - let sname = [ `CN sname ] in - let csr = X509.CA.request sname skey in - Albatross_provision.sign ~dbname:(Fpath.v db) s_exts name key csr (Duration.of_day sdays) - with - | Ok () -> `Ok () - | Error (`Msg e) -> `Error (false, e) + Albatross_provision.priv_key ~bits:4096 None name >>= fun key -> + let name = [ `CN name ] in + let csr = X509.CA.request name key in + Albatross_provision.sign ~certname:"cacert" (d_exts ()) name key csr (Duration.of_day days) >>= fun () -> + Albatross_provision.priv_key None sname >>= fun skey -> + let sname = [ `CN sname ] in + let csr = X509.CA.request sname skey in + Albatross_provision.sign ~dbname:(Fpath.v db) s_exts name key csr (Duration.of_day sdays) open Cmdliner open Albatross_cli @@ -123,7 +115,7 @@ let generate_cmd = [`S "DESCRIPTION"; `P "Generates a certificate authority."] in - Term.(ret (const generate $ setup_log $ Albatross_provision.nam $ db $ days $ sname $ sday)), + Term.(term_result (const generate $ setup_log $ Albatross_provision.nam $ db $ days $ sname $ sday)), Term.info "generate" ~doc ~man let days = @@ -140,7 +132,7 @@ let sign_cmd = [`S "DESCRIPTION"; `P "Signs the certificate signing request."] in - Term.(ret (const sign $ setup_log $ db $ cacert $ key $ csr $ days)), + Term.(term_result (const sign $ setup_log $ db $ cacert $ key $ csr $ days)), Term.info "sign" ~doc ~man let help_cmd = diff --git a/provision/albatross_provision_request.ml b/provision/albatross_provision_request.ml index db0d224..22f8287 100644 --- a/provision/albatross_provision_request.ml +++ b/provision/albatross_provision_request.ml @@ -16,14 +16,10 @@ let csr priv name cmd = let jump id cmd = Nocrypto_entropy_unix.initialize () ; let name = Vmm_core.Name.to_string id in - match - priv_key None name >>= fun priv -> - let csr = csr priv name cmd in - let enc = X509.Encoding.Pem.Certificate_signing_request.to_pem_cstruct1 csr in - Bos.OS.File.write Fpath.(v name + ".req") (Cstruct.to_string enc) - with - | Ok () -> `Ok () - | Error (`Msg m) -> `Error (false, m) + priv_key None name >>= fun priv -> + let csr = csr priv name cmd in + let enc = X509.Encoding.Pem.Certificate_signing_request.to_pem_cstruct1 csr in + Bos.OS.File.write Fpath.(v name + ".req") (Cstruct.to_string enc) let info_policy _ name = jump name (`Policy_cmd `Policy_info) @@ -43,7 +39,7 @@ let destroy _ name = let create _ force name image cpuid memory argv block network compression = match Albatross_cli.create_vm force image cpuid memory argv block network compression with | Ok cmd -> jump name (`Unikernel_cmd cmd) - | Error (`Msg msg) -> `Error (false, msg) + | Error (`Msg msg) -> Error (`Msg msg) let console _ name since = jump name (`Console_cmd (`Console_subscribe since)) @@ -77,7 +73,7 @@ let destroy_cmd = [`S "DESCRIPTION"; `P "Destroy a virtual machine."] in - Term.(ret (const destroy $ setup_log $ vm_name)), + Term.(term_result (const destroy $ setup_log $ vm_name)), Term.info "destroy" ~doc ~man let remove_policy_cmd = @@ -86,7 +82,7 @@ let remove_policy_cmd = [`S "DESCRIPTION"; `P "Removes a policy."] in - Term.(ret (const remove_policy $ setup_log $ opt_vm_name)), + Term.(term_result (const remove_policy $ setup_log $ opt_vm_name)), Term.info "remove_policy" ~doc ~man let info_cmd = @@ -95,7 +91,7 @@ let info_cmd = [`S "DESCRIPTION"; `P "Shows information about VMs."] in - Term.(ret (const info_ $ setup_log $ opt_vm_name)), + Term.(term_result (const info_ $ setup_log $ opt_vm_name)), Term.info "info" ~doc ~man let policy_cmd = @@ -104,7 +100,7 @@ let policy_cmd = [`S "DESCRIPTION"; `P "Shows information about policies."] in - Term.(ret (const info_policy $ setup_log $ opt_vm_name)), + Term.(term_result (const info_policy $ setup_log $ opt_vm_name)), Term.info "policy" ~doc ~man let add_policy_cmd = @@ -113,7 +109,7 @@ let add_policy_cmd = [`S "DESCRIPTION"; `P "Adds a policy."] in - Term.(ret (const add_policy $ setup_log $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), + Term.(term_result (const add_policy $ setup_log $ vm_name $ vms $ mem $ cpus $ opt_block_size $ bridge)), Term.info "add_policy" ~doc ~man let create_cmd = @@ -122,7 +118,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), + Term.(term_result (const create $ setup_log $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = @@ -131,7 +127,7 @@ let console_cmd = [`S "DESCRIPTION"; `P "Shows console output of a VM."] in - Term.(ret (const console $ setup_log $ vm_name $ since)), + Term.(term_result (const console $ setup_log $ vm_name $ since)), Term.info "console" ~doc ~man let stats_cmd = @@ -140,7 +136,7 @@ let stats_cmd = [`S "DESCRIPTION"; `P "Shows statistics of VMs."] in - Term.(ret (const stats $ setup_log $ opt_vm_name)), + Term.(term_result (const stats $ setup_log $ opt_vm_name)), Term.info "stats" ~doc ~man let log_cmd = @@ -149,7 +145,7 @@ let log_cmd = [`S "DESCRIPTION"; `P "Shows event log of VM."] in - Term.(ret (const event_log $ setup_log $ opt_vm_name $ since)), + Term.(term_result (const event_log $ setup_log $ opt_vm_name $ since)), Term.info "log" ~doc ~man let block_info_cmd = @@ -158,7 +154,7 @@ let block_info_cmd = [`S "DESCRIPTION"; `P "Block device information."] in - Term.(ret (const block_info $ setup_log $ opt_block_name)), + Term.(term_result (const block_info $ setup_log $ opt_block_name)), Term.info "block" ~doc ~man let block_create_cmd = @@ -167,7 +163,7 @@ let block_create_cmd = [`S "DESCRIPTION"; `P "Creation of a block device."] in - Term.(ret (const block_create $ setup_log $ block_name $ block_size)), + Term.(term_result (const block_create $ setup_log $ block_name $ block_size)), Term.info "create_block" ~doc ~man let block_destroy_cmd = @@ -176,7 +172,7 @@ let block_destroy_cmd = [`S "DESCRIPTION"; `P "Destroys a block device."] in - Term.(ret (const block_destroy $ setup_log $ block_name)), + Term.(term_result (const block_destroy $ setup_log $ block_name)), Term.info "destroy_block" ~doc ~man let help_cmd = diff --git a/stats/albatross_stat_client.ml b/stats/albatross_stat_client.ml index 211db50..e71f5d0 100644 --- a/stats/albatross_stat_client.ml +++ b/stats/albatross_stat_client.ml @@ -51,7 +51,7 @@ let vmname = Arg.(value & opt (some string) None & info [ "name" ] ~doc) let cmd = - Term.(ret (const jump $ setup_log $ pid $ vmname $ interval)), + Term.(term_result (const jump $ setup_log $ pid $ vmname $ interval)), Term.info "albatross_stat_client" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 diff --git a/stats/albatross_stats.ml b/stats/albatross_stats.ml index 788c313..28cf8fc 100644 --- a/stats/albatross_stats.ml +++ b/stats/albatross_stats.ml @@ -94,7 +94,7 @@ let interval = Arg.(value & opt int 10 & info [ "interval" ] ~doc) let cmd = - Term.(ret (const jump $ setup_log $ socket $ interval)), + Term.(term_result (const jump $ setup_log $ socket $ interval)), Term.info "albatross_stats" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 diff --git a/tls/albatross_tls_endpoint.ml b/tls/albatross_tls_endpoint.ml index 19f51c1..74d0367 100644 --- a/tls/albatross_tls_endpoint.ml +++ b/tls/albatross_tls_endpoint.ml @@ -59,7 +59,7 @@ let port = Arg.(value & opt int 1025 & info [ "port" ] ~doc) let cmd = - Term.(ret (const jump $ setup_log $ cacert $ cert $ key $ port)), + Term.(const jump $ setup_log $ cacert $ cert $ key $ port), Term.info "albatross_tls_endpoint" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 diff --git a/tls/albatross_tls_inetd.ml b/tls/albatross_tls_inetd.ml index 00d8f49..f5d3880 100644 --- a/tls/albatross_tls_inetd.ml +++ b/tls/albatross_tls_inetd.ml @@ -22,13 +22,12 @@ let jump cacert cert priv_key = Vmm_tls_lwt.close t) (fun e -> Logs.err (fun m -> m "error while handle() %s" (Printexc.to_string e)) ; - Vmm_tls_lwt.close t)) ; - `Ok () + Vmm_tls_lwt.close t)) open Cmdliner let cmd = - Term.(ret (const jump $ cacert $ cert $ key)), + Term.(const jump $ cacert $ cert $ key), Term.info "albatross_tls_inetd" ~version:"%%VERSION_NUM%%" let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1