reynir
/
albatross
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use cmdliner.1.0.0, especially term_result 

move albatross_cli to a custom directory (command-line)
This commit is contained in:
Hannes Mehnert 2019-04-08 16:40:58 +02:00
parent 45f37389aa
commit 95a46638fa
14 changed files with 78 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
albatross.opam
View File

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

28
client/albatross_client_bistro.ml
View File

@ -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 =

32
client/albatross_client_local.ml
View File

@ -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 =

0
daemon/albatross_cli.ml → command-line/albatross_cli.ml
View File

6
command-line/dune Normal file
View File

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

2
daemon/albatross_console.ml
View File

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

2
daemon/albatross_log.ml
View File

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

7
daemon/dune
View File

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

42
provision/albatross_provision_ca.ml
View File

@ -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 =

38
provision/albatross_provision_request.ml
View File

@ -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 =

2
stats/albatross_stat_client.ml
View File

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

2
stats/albatross_stats.ml
View File

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

2
tls/albatross_tls_endpoint.ml
View File

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

5
tls/albatross_tls_inetd.ml
View File

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