use cmdliner.1.0.0, especially term_result

move albatross_cli to a custom directory (command-line)

albatross.opam

@@ -16,7 +16,7 @@ depends: [
   "rresult"
   "bos"
   "ptime"
-  "cmdliner"
+  "cmdliner" {>= "1.0.0"}
   "fmt"
   "astring"
   "x509" {>= "0.6.0"}

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 =

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 =

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))

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

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

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)

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 ->
-    Bos.OS.File.read (Fpath.v cacert) >>= fun cacert ->
+  let cacert = X509.Encoding.Pem.Certificate.of_pem_cstruct1 (Cstruct.of_string cacert) in
-    let cacert = X509.Encoding.Pem.Certificate.of_pem_cstruct1 (Cstruct.of_string cacert) in
+  Bos.OS.File.read (Fpath.v cakey) >>= fun pk ->
-    Bos.OS.File.read (Fpath.v cakey) >>= fun pk ->
+  let cakey = X509.Encoding.Pem.Private_key.of_pem_cstruct1 (Cstruct.of_string pk) in
-    let cakey = X509.Encoding.Pem.Private_key.of_pem_cstruct1 (Cstruct.of_string pk) in
+  Bos.OS.File.read (Fpath.v csrname) >>= fun enc ->
-    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
-    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
-    sign_csr (Fpath.v db) cacert cakey csr days
-  with
-  | Ok () -> `Ok ()
-  | Error (`Msg e) -> `Error (false, e)
 
 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 ->
-    Albatross_provision.priv_key ~bits:4096 None name >>= fun key ->
+  let name = [ `CN name ] in
-    let name = [ `CN name ] in
+  let csr = X509.CA.request name key 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.sign ~certname:"cacert" (d_exts ()) name key csr (Duration.of_day days) >>= fun () ->
+  Albatross_provision.priv_key None sname >>= fun skey ->
-    Albatross_provision.priv_key None sname >>= fun skey ->
+  let sname = [ `CN sname ] in
-    let sname = [ `CN sname ] in
+  let csr = X509.CA.request sname skey 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)
-    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)
 
 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 =

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 ->
-    priv_key None name >>= fun priv ->
+  let csr = csr priv name cmd in
-    let csr = csr priv name cmd in
+  let enc = X509.Encoding.Pem.Certificate_signing_request.to_pem_cstruct1 csr 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)
-    Bos.OS.File.write Fpath.(v name + ".req") (Cstruct.to_string enc)
-  with
-  | Ok () -> `Ok ()
-  | Error (`Msg m) -> `Error (false, m)
 
 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 =

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

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

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

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)) ;
+          Vmm_tls_lwt.close t))
-  `Ok ()
 
 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