use vmm_cli

app/vmm_cli.ml

@@ -9,3 +9,48 @@ let setup_log =
   Term.(const setup_log
         $ Fmt_cli.style_renderer ()
         $ Logs_cli.level ())
+
+let host_port : (string * int) Arg.converter =
+  let parse s =
+    match Astring.String.cut ~sep:":" s with
+    | None -> `Error "broken: no port specified"
+    | Some (hostname, port) ->
+      try
+        `Ok (hostname, int_of_string port)
+      with
+        Not_found -> `Error "failed to parse port"
+  in
+  parse, fun ppf (h, p) -> Format.fprintf ppf "%s:%d" h p
+
+let bridge =
+  let parse s =
+    match Astring.String.cuts ~sep:"/" s with
+    | [ name ; fst ; lst ; gw ; nm ] ->
+      begin match Ipaddr.V4.(of_string fst, of_string lst, of_string gw) with
+        | Some fst, Some lst, Some gw ->
+          (try
+             let nm = int_of_string nm in
+             if nm > 0 && nm <= 32 then
+               let net = Ipaddr.V4.Prefix.make nm gw in
+               if Ipaddr.V4.Prefix.mem fst net && Ipaddr.V4.Prefix.mem lst net then
+                 `Ok (`External (name, fst, lst, gw, nm))
+               else
+                 `Error "first or last IP are not in subnet"
+             else
+               `Error "netmask must be > 0 and <= 32"
+           with Failure _ -> `Error "couldn't parse netmask")
+        | _ -> `Error "couldn't parse IP address"
+      end
+    | [ name ] -> `Ok (`Internal name)
+    | _ -> `Error "couldn't parse bridge (either 'name' or 'name/fstIP/lstIP/gwIP/netmask')"
+  in
+  (parse, Vmm_core.pp_bridge)
+
+let vm_c =
+  let parse s = `Ok (Vmm_core.id_of_string s)
+  in
+  (parse, Vmm_core.pp_id)
+
+let opt_vm_name =
+  let doc = "name of virtual machine." in
+  Arg.(value & opt vm_c [] & info [ "n" ; "name"] ~doc)

app/vmmc_local.ml

@@ -117,21 +117,12 @@ let help _ _ man_format cmds = function
   | Some t when List.mem t cmds -> `Help (man_format, Some t)
   | Some _ -> List.iter print_endline cmds; `Ok ()
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
 
 let socket =
   let doc = "Socket to connect to" in
-  Arg.(value & opt (some string) None & info [ "s" ; "socket" ] ~doc)
+  Arg.(value & opt (some string) None & info [ "socket" ] ~doc)
 
 let force =
   let doc = "force VM creation." in
@@ -141,11 +132,6 @@ let image =
   let doc = "File of virtual machine image." in
   Arg.(required & pos 1 (some file) None & info [] ~doc)
 
-let vm_c =
-  let parse s = `Ok (Vmm_core.id_of_string s)
-  in
-  (parse, Vmm_core.pp_id)
-
 let vm_name =
   let doc = "Name virtual machine." in
   Arg.(required & pos 0 (some vm_c) None & info [] ~doc)
@@ -159,17 +145,13 @@ let destroy_cmd =
   Term.(ret (const destroy $ setup_log $ socket $ vm_name)),
   Term.info "destroy" ~doc ~man
 
-let opt_vmname =
-  let doc = "Name virtual machine." in
-  Arg.(value & opt vm_c [] & info [ "n" ; "name"] ~doc)
-
 let remove_policy_cmd =
   let doc = "removes a policy" in
   let man =
     [`S "DESCRIPTION";
      `P "Removes a policy."]
   in
-  Term.(ret (const remove_policy $ setup_log $ socket $ opt_vmname)),
+  Term.(ret (const remove_policy $ setup_log $ socket $ opt_vm_name)),
   Term.info "remove_policy" ~doc ~man
 
 let info_cmd =
@@ -178,7 +160,7 @@ let info_cmd =
     [`S "DESCRIPTION";
      `P "Shows information about VMs."]
   in
-  Term.(ret (const info_ $ setup_log $ socket $ opt_vmname)),
+  Term.(ret (const info_ $ setup_log $ socket $ opt_vm_name)),
   Term.info "info" ~doc ~man
 
 let policy_cmd =
@@ -187,11 +169,11 @@ let policy_cmd =
     [`S "DESCRIPTION";
      `P "Shows information about policies."]
   in
-  Term.(ret (const policy $ setup_log $ socket $ opt_vmname)),
+  Term.(ret (const policy $ setup_log $ socket $ opt_vm_name)),
   Term.info "policy" ~doc ~man
 
 let cpus =
-  let doc = "CPUids to allow" in
+  let doc = "CPUs to allow" in
   Arg.(value & opt_all int [] & info [ "cpu" ] ~doc)
 
 let vms =
@@ -206,33 +188,9 @@ let mem =
   let doc = "Memory to allow" in
   Arg.(value & opt int 512 & info [ "mem" ] ~doc)
 
-let b =
-  let parse s =
-    match String.cuts ~sep:"/" s with
-    | [ name ; fst ; lst ; gw ; nm ] ->
-      begin match Ipaddr.V4.(of_string fst, of_string lst, of_string gw) with
-        | Some fst, Some lst, Some gw ->
-          (try
-             let nm = int_of_string nm in
-             if nm > 0 && nm <= 32 then
-               let net = Ipaddr.V4.Prefix.make nm gw in
-               if Ipaddr.V4.Prefix.mem fst net && Ipaddr.V4.Prefix.mem lst net then
-                 `Ok (`External (name, fst, lst, gw, nm))
-               else
-                 `Error "first or last IP are not in subnet"
-             else
-               `Error "netmask must be > 0 and <= 32"
-           with Failure _ -> `Error "couldn't parse netmask")
-        | _ -> `Error "couldn't parse IP address"
-      end
-    | [ name ] -> `Ok (`Internal name)
-    | _ -> `Error "couldn't parse bridge (either 'name' or 'name/fstIP/lstIP/gwIP/netmask')"
-  in
-  (parse, Vmm_core.pp_bridge)
-
 let bridge =
-  let doc = "Bridge to provision" in
+  let doc = "Bridge to allow" in
-  Arg.(value & opt_all b [] & info [ "bridge" ] ~doc)
+  Arg.(value & opt_all bridge [] & info [ "bridge" ] ~doc)
 
 let add_policy_cmd =
   let doc = "Add a policy" in
@@ -240,7 +198,7 @@ let add_policy_cmd =
     [`S "DESCRIPTION";
      `P "Adds a policy."]
   in
-  Term.(ret (const add_policy $ setup_log $ socket $ opt_vmname $ vms $ mem $ cpus $ block $ bridge)),
+  Term.(ret (const add_policy $ setup_log $ socket $ opt_vm_name $ vms $ mem $ cpus $ block $ bridge)),
   Term.info "add_policy" ~doc ~man
 
 let cpu =
@@ -294,7 +252,7 @@ let stats_cmd =
     [`S "DESCRIPTION";
      `P "Shows statistics of VMs."]
   in
-  Term.(ret (const stats $ setup_log $ socket $ opt_vmname)),
+  Term.(ret (const stats $ setup_log $ socket $ opt_vm_name)),
   Term.info "stats" ~doc ~man
 
 let log_cmd =
@@ -303,7 +261,7 @@ let log_cmd =
     [`S "DESCRIPTION";
      `P "Shows event log of VM."]
   in
-  Term.(ret (const event_log $ setup_log $ socket $ opt_vmname $ since)),
+  Term.(ret (const event_log $ setup_log $ socket $ opt_vm_name $ since)),
   Term.info "log" ~doc ~man
 
 let help_cmd =

app/vmmc_remote.ml

@@ -23,7 +23,6 @@ let client cas host port cert priv_key =
     Lwt_unix.gethostbyname host >>= fun host_entry ->
     let host_inet_addr = Array.get host_entry.Lwt_unix.h_addr_list 0 in
     let fd = Lwt_unix.socket host_entry.Lwt_unix.h_addrtype Lwt_unix.SOCK_STREAM 0 in
-
     Lwt_unix.connect fd (Lwt_unix.ADDR_INET (host_inet_addr, port)) >>= fun _ ->
     X509_lwt.private_of_pems ~cert ~priv_key >>= fun cert ->
     let certificates = `Single cert in
@@ -43,33 +42,8 @@ let run_client _ cas cert key (host, port) =
   Sys.(set_signal sigpipe Signal_ignore) ;
   Lwt_main.run (client cas host port cert key)
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
-
-let host_port : (string * int) Arg.converter =
-  let parse s =
-    try
-      let open String in
-      let colon = index s ':' in
-      let hostname = sub s 0 colon
-      and port =
-        let csucc = succ colon in
-        sub s csucc (length s - csucc)
-      in
-      `Ok (hostname, int_of_string port)
-    with
-      Not_found -> `Error "broken"
-  in
-  parse, fun ppf (h, p) -> Format.fprintf ppf "%s:%d" h p
 
 let cas =
   let doc = "The full path to PEM encoded certificate authorities. Can either be a FILE or a DIRECTORY." in
@@ -88,13 +62,13 @@ let destination =
          ~doc:"the destination hostname:port to connect to")
 
 let cmd =
-  let doc = "VMM TLS client" in
+  let doc = "VMM remote TLS client" in
   let man = [
     `S "DESCRIPTION" ;
     `P "$(tname) connects to a server and initiates a TLS handshake" ]
   in
   Term.(pure run_client $ setup_log $ cas $ client_cert $ client_key $ destination),
-  Term.info "vmmd_remote" ~version:"%%VERSION_NUM%%" ~doc ~man
+  Term.info "vmmc_remote" ~version:"%%VERSION_NUM%%" ~doc ~man
 
 let () =
   match Term.eval cmd

app/vmmd.ml

@@ -51,7 +51,6 @@ let create process cont =
     | Ok () -> ()
 
 let handle out fd addr =
-  (* out is for `Log | `Stat | `Cons (including reconnect semantics) *)
   Logs.debug (fun m -> m "connection from %a" Vmm_lwt.pp_sockaddr addr) ;
   (* now we need to read a packet and handle it
     (1)
@@ -152,8 +151,6 @@ let rec stats_loop () =
   Lwt_unix.sleep 600. >>= fun () ->
   stats_loop ()
 
-(* TODO nobody reads stat and log file descriptors - that's likely a bad idea!
-   - create_mbox could after take & write do a read and check for failures! *)
 let jump _ =
   Sys.(set_signal sigpipe Signal_ignore) ;
   Lwt_main.run

app/vmmd_console.ml

@@ -170,22 +170,13 @@ let jump _ file =
      in
      loop ())
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
 
-let setup_log =
+open Vmm_cli
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
 
 let socket =
-  let doc = "Socket to listen on" in
+  let doc = "socket to use" in
-  let sock = Vmm_core.socket_path `Console in
+  Arg.(value & opt string (Vmm_core.socket_path `Console) & info [ "socket" ] ~doc)
-  Arg.(value & opt string sock & info [ "s" ; "socket" ] ~doc)
 
 let cmd =
   Term.(ret (const jump $ setup_log $ socket)),

app/vmmd_influx.ml

@@ -279,55 +279,24 @@ let run_client _ socket (influxhost, influxport) vm =
   Sys.(set_signal sigpipe Signal_ignore) ;
   Lwt_main.run (client socket influxhost influxport vm)
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
-
-let host_port : (string * int) Arg.converter =
-  let parse s =
-    match String.cut ~sep:":" s with
-    | None -> `Error "broken: no port specified"
-    | Some (hostname, port) ->
-      try
-        `Ok (hostname, int_of_string port)
-      with
-        Not_found -> `Error "failed to parse port"
-  in
-  parse, fun ppf (h, p) -> Format.fprintf ppf "%s:%d" h p
 
 let socket =
-  let doc = "Stat socket to connect onto" in
+  let doc = "socket to use" in
-  let sock = Vmm_core.socket_path `Stats in
+  Arg.(value & opt string (Vmm_core.socket_path `Stats) & info [ "socket" ] ~doc)
-  Arg.(value & opt string sock & info [ "s" ; "socket" ] ~doc)
 
 let influx =
   Arg.(required & pos 0 (some host_port) None & info [] ~docv:"influx"
          ~doc:"the influx hostname:port to connect to")
 
-let vm_c =
-  let parse s = `Ok (Vmm_core.id_of_string s)
-  in
-  (parse, Vmm_core.pp_id)
-
-let opt_vmname =
-  let doc = "Name virtual machine." in
-  Arg.(value & opt vm_c [] & info [ "n" ; "name"] ~doc)
-
 let cmd =
   let doc = "VMM InfluxDB connector" in
   let man = [
     `S "DESCRIPTION" ;
     `P "$(tname) connects to a vmm stats socket, pulls statistics and pushes them via TCP to influxdb" ]
   in
-  Term.(pure run_client $ setup_log $ socket $ influx $ opt_vmname),
+  Term.(pure run_client $ setup_log $ socket $ influx $ opt_vm_name),
   Term.info "vmmd_influx" ~version:"%%VERSION_NUM%%" ~doc ~man
 
 let () =

app/vmmd_log.ml

@@ -71,8 +71,6 @@ let write_to_file file =
   in
   mvar, write_loop
 
-let tree = ref Vmm_trie.empty
-
 let send_history s ring id ts =
   let elements =
     match ts with
@@ -96,6 +94,8 @@ let send_history s ring id ts =
       | Error e -> Lwt.return (Error e))
     (Ok ()) (List.rev res)
 
+let tree = ref Vmm_trie.empty
+
 let handle_data s mvar ring hdr entry =
   if not (Vmm_commands.version_eq hdr.Vmm_commands.version my_version) then begin
     Logs.warn (fun m -> m "unsupported version") ;
@@ -187,22 +187,12 @@ let jump _ file sock =
      Lwt.pick [ loop () ; writer () ]) ;
   `Ok ()
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
 
 let socket =
-  let doc = "Socket to listen on" in
+  let doc = "socket to use" in
-  let sock = Vmm_core.socket_path `Log in
+  Arg.(value & opt string (Vmm_core.socket_path `Log) & info [ "socket" ] ~doc)
-  Arg.(value & opt string sock & info [ "s" ; "socket" ] ~doc)
 
 let file =
   let doc = "File to write the log to" in

app/vmmd_stats.ml

@@ -92,26 +92,16 @@ let jump _ file interval =
      in
      loop ())
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
 
 let socket =
-  let doc = "Socket to listen on" in
+  let doc = "socket to use" in
-  let sock = Vmm_core.socket_path `Stats in
+  Arg.(value & opt string (Vmm_core.socket_path `Stats) & info [ "socket" ] ~doc)
-  Arg.(value & opt string sock & info [ "s" ; "socket" ] ~doc)
 
 let interval =
   let doc = "Interval between statistics gatherings (in seconds)" in
-  Arg.(value & opt int 10 & info [ "internval" ] ~doc)
+  Arg.(value & opt int 10 & info [ "interval" ] ~doc)
 
 let cmd =
   Term.(ret (const jump $ setup_log $ socket $ interval)),

app/vmmd_tls.ml

@@ -135,19 +135,8 @@ let jump _ cacert cert priv_key port =
      in
      loop ())
 
-let setup_log style_renderer level =
-  Fmt_tty.setup_std_outputs ?style_renderer ();
-  Logs.set_level level;
-  Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ())
-
 open Cmdliner
-
+open Vmm_cli
-let setup_log =
-  Term.(const setup_log
-        $ Fmt_cli.style_renderer ()
-        $ Logs_cli.level ())
-
-(* TODO needs CRL as well, plus socket(s) *)
 
 let cacert =
   let doc = "CA certificate" in

app/vmmp_request.ml

@@ -107,6 +107,7 @@ let jump _ name key vms mem cpus block bridges =
   | Error (`Msg m) -> `Error (false, m)
 
 open Cmdliner
+open Vmm_cli
 
 let cpus =
   let doc = "CPUids to provision" in
@@ -120,33 +121,9 @@ let block =
   let doc = "Block storage to provision" in
   Arg.(value & opt (some int) None & info [ "block" ] ~doc)
 
-let b =
-  let parse s =
-    match String.cuts ~sep:"/" s with
-    | [ name ; fst ; lst ; gw ; nm ] ->
-      begin match Ipaddr.V4.(of_string fst, of_string lst, of_string gw) with
-        | Some fst, Some lst, Some gw ->
-          (try
-             let nm = int_of_string nm in
-             if nm > 0 && nm <= 32 then
-               let net = Ipaddr.V4.Prefix.make nm gw in
-               if Ipaddr.V4.Prefix.mem fst net && Ipaddr.V4.Prefix.mem lst net then
-                 `Ok (`External (name, fst, lst, gw, nm))
-               else
-                 `Error "first or last IP are not in subnet"
-             else
-               `Error "netmask must be > 0 and <= 32"
-           with Failure _ -> `Error "couldn't parse netmask")
-        | _ -> `Error "couldn't parse IP address"
-      end
-    | [ name ] -> `Ok (`Internal name)
-    | _ -> `Error "couldn't parse bridge (either 'name' or 'name/fstIP/lstIP/gwIP/netmask')"
-  in
-  (parse, Vmm_core.pp_bridge)
-
 let bridge =
   let doc = "Bridge to provision" in
-  Arg.(value & opt_all b [] & info [ "bridge" ] ~doc)
+  Arg.(value & opt_all bridge [] & info [ "bridge" ] ~doc)
 
 let cmd =
   Term.(ret (const jump $ setup_log $ nam $ key $ vms $ mem $ cpus $ block $ bridge)),