[Libguestfs] [PATCH 2/2] OCaml tools: add output selection for --machine-readable

Pino Toscano
Tue, 21 Aug 2018 15:44:30 -0000

Add an optional argument for --machine-readable to select the output,
adding a new function to specifically write data to that output stream.
The possible choices are:
* --machine-readable: to stdout, like before
* --machine-readable=file:name-of-file: to the specified file
* --machine-readable=stream:stdout: explicitly to stdout
* --machine-readable=stream:stderr: explicitly to stderr

Adapt all the OCaml-based tools to use the new function, so the
--machine-readable choice is respected.
---
 builder/cmdline.ml             | 12 ++++----
 builder/repository_main.ml     |  2 +-
 common/mltools/tools_utils.ml  | 52 +++++++++++++++++++++++++++++++++-
 common/mltools/tools_utils.mli |  6 ++++
 dib/cmdline.ml                 |  4 +--
 get-kernel/get_kernel.ml       |  2 +-
 resize/resize.ml               | 22 +++++++-------
 sparsify/cmdline.ml            | 16 +++++------
 v2v/cmdline.ml                 | 28 +++++++++---------
 9 files changed, 100 insertions(+), 44 deletions(-)

diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 9c854ed49..1771ef046 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -218,12 +218,12 @@ read the man page virt-builder(1).

   (* No arguments and machine-readable mode?  Print some facts. *)
   if args = [] && machine_readable () then (
-    printf "virt-builder\n";
-    printf "arch\n";
-    printf "config-file\n";
-    printf "customize\n";
-    printf "json-list\n";
-    if Pxzcat.using_parallel_xzcat () then printf "pxzcat\n";
+    machine_readable_printf "virt-builder\n";
+    machine_readable_printf "arch\n";
+    machine_readable_printf "config-file\n";
+    machine_readable_printf "customize\n";
+    machine_readable_printf "json-list\n";
+    if Pxzcat.using_parallel_xzcat () then machine_readable_printf
"pxzcat\n";
     exit 0
   );

diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index 49612d7b9..393c47d43 100644
--- a/builder/repository_main.ml
+++ b/builder/repository_main.ml
@@ -75,7 +75,7 @@ read the man page virt-builder-repository(1).
    * this binary supports.
    *)
   if machine_readable () then (
-    printf "virt-builder-repository\n";
+    machine_readable_printf "virt-builder-repository\n";
     exit 0
   );

diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 920977e42..271e7d55f 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -229,10 +229,60 @@ let human_size i      )
   )

+type machine_readable_output_type +  | NoOutput
+  | Channel of out_channel
+  | File of string
+let machine_readable_output = ref NoOutput
+let machine_readable_channel = ref None
+let machine_readable_printf fs +  let get_machine_readable_channel () +    let
open_machine_readable_channel () +      match !machine_readable_output with
+      | NoOutput ->
+        (* Trying to use machine_readable_printf when --machine-readable was
+         * not enabled, and thus machine_readable () returns false.
+         *)
+        failwith "internal error: machine_readable_printf used with no
--machine-readable"
+      | Channel chan -> chan
+      | File f -> open_out f
+    in
+    match !machine_readable_channel with
+    | Some chan -> chan
+    | None ->
+      let chan = open_machine_readable_channel () in
+      machine_readable_channel := Some chan;
+      chan
+  in
+  fprintf (get_machine_readable_channel ()) fs
+
 let create_standard_options argspec ?anon_fun ?(key_opts = false)
?(machine_readable = false) usage_msg    (** Install an exit hook to check gc
consistency for --debug-gc *)
   let set_debug_gc ()      at_exit (fun () -> Gc.compact()) in
+  let parse_machine_readable = function
+    | None ->
+      machine_readable_output := Channel stdout;
+      set_machine_readable ()
+    | Some fmt ->
+      let outtype, outname = String.split ":" fmt in
+      if outname = "" then
+        error (f_"invalid format string for --machine-readable: %s")
fmt;
+      (match outtype with
+      | "file" -> machine_readable_output := File outname
+      | "stream" ->
+        let chan +          match outname with
+          | "stdout" -> stdout
+          | "stderr" -> stderr
+          | n ->
+            error (f_"invalid output stream for --machine-readable:
%s") fmt in
+        machine_readable_output := Channel chan
+      | n ->
+        error (f_"invalid output for --machine-readable: %s") fmt
+      );
+      set_machine_readable ()
+  in
   let argspec = [
     [ S 'V'; L"version" ], Getopt.Unit
print_version_and_exit, s_"Display version and exit";
     [ S 'v'; L"verbose" ], Getopt.Unit set_verbose,
s_"Enable libguestfs debugging messages";
@@ -252,7 +302,7 @@ let create_standard_options argspec ?anon_fun ?(key_opts =
false) ?(machine_read
       else []) @
       (if machine_readable then
       [
-        [ L"machine-readable" ], Getopt.Unit set_machine_readable,
s_"Make output machine readable";
+        [ L"machine-readable" ], Getopt.OptString
("format", parse_machine_readable), s_"Make output machine
readable";
       ]
       else []) in
   Getopt.create argspec ?anon_fun usage_msg
diff --git a/common/mltools/tools_utils.mli b/common/mltools/tools_utils.mli
index c56f7b660..871911c6e 100644
--- a/common/mltools/tools_utils.mli
+++ b/common/mltools/tools_utils.mli
@@ -64,6 +64,12 @@ val parse_resize : int64 -> string -> int64
 val human_size : int64 -> string
 (** Converts a size in bytes to a human-readable string. *)

+val machine_readable_printf : ('a, out_channel, unit) format -> 'a
+(** Function to output something to the separate machine-readable
+    stream.
+
+    It must be used {b only} when {!machine_readable} is [true]. *)
+
 val create_standard_options : Getopt.speclist -> ?anon_fun:Getopt.anon_fun
-> ?key_opts:bool -> ?machine_readable:bool -> Getopt.usage_msg ->
Getopt.t
 (** Adds the standard libguestfs command line options to the specified ones,
     sorting them, and setting [long_options] to them.
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index f5e8ec9cb..cbb1f48be 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -229,9 +229,9 @@ read the man page virt-dib(1).

   (* No elements and machine-readable mode?  Print some facts. *)
   if elements = [] && machine_readable () then (
-    printf "virt-dib\n";
+    machine_readable_printf "virt-dib\n";
     let formats_list = Output_format.list_formats () in
-    List.iter (printf "output:%s\n") formats_list;
+    List.iter (machine_readable_printf "output:%s\n") formats_list;
     exit 0
   );

diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index f2949da89..34300d802 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -76,7 +76,7 @@ read the man page virt-get-kernel(1).
    * this binary supports.
    *)
   if machine_readable () then (
-    printf "virt-get-kernel\n";
+    machine_readable_printf "virt-get-kernel\n";
     exit 0
   );

diff --git a/resize/resize.ml b/resize/resize.ml
index 9d2fdaf40..e88505434 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -277,24 +277,24 @@ read the man page virt-resize(1).
      * of the appliance.
      *)
     if !disks = [] && machine_readable () then (
-      printf "virt-resize\n";
-      printf "ntfsresize-force\n";
-      printf "32bitok\n";
-      printf "128-sector-alignment\n";
-      printf "alignment\n";
-      printf "align-first\n";
-      printf "infile-uri\n";
+      machine_readable_printf "virt-resize\n";
+      machine_readable_printf "ntfsresize-force\n";
+      machine_readable_printf "32bitok\n";
+      machine_readable_printf "128-sector-alignment\n";
+      machine_readable_printf "alignment\n";
+      machine_readable_printf "align-first\n";
+      machine_readable_printf "infile-uri\n";
       let g = open_guestfs () in
       g#add_drive "/dev/null";
       g#launch ();
       if g#feature_available [| "ntfsprogs"; "ntfs3g" |]
then
-        printf "ntfs\n";
+        machine_readable_printf "ntfs\n";
       if g#feature_available [| "btrfs" |] then
-        printf "btrfs\n";
+        machine_readable_printf "btrfs\n";
       if g#feature_available [| "xfs" |] then
-        printf "xfs\n";
+        machine_readable_printf "xfs\n";
       if g#feature_available [| "f2fs" |] then
-        printf "f2fs\n";
+        machine_readable_printf "f2fs\n";
       exit 0
     );

diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index b0af053ac..4070d46bf 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -107,19 +107,19 @@ read the man page virt-sparsify(1).
    * about what this binary supports.
    *)
   if disks = [] && machine_readable () then (
-    printf "virt-sparsify\n";
-    printf "linux-swap\n";
-    printf "zero\n";
-    printf "check-tmpdir\n";
-    printf "in-place\n";
-    printf "tmp-option\n";
+    machine_readable_printf "virt-sparsify\n";
+    machine_readable_printf "linux-swap\n";
+    machine_readable_printf "zero\n";
+    machine_readable_printf "check-tmpdir\n";
+    machine_readable_printf "in-place\n";
+    machine_readable_printf "tmp-option\n";
     let g = open_guestfs () in
     g#add_drive "/dev/null";
     g#launch ();
     if g#feature_available [| "ntfsprogs"; "ntfs3g" |] then
-      printf "ntfs\n";
+      machine_readable_printf "ntfs\n";
     if g#feature_available [| "btrfs" |] then
-      printf "btrfs\n";
+      machine_readable_printf "btrfs\n";
     exit 0
   );

diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 10cbb90e6..babf1c002 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -334,20 +334,20 @@ read the man page virt-v2v(1).
    * about what this binary supports.
    *)
   if args = [] && machine_readable () then (
-    printf "virt-v2v\n";
-    printf "libguestfs-rewrite\n";
-    printf "vcenter-https\n";
-    printf "xen-ssh\n";
-    printf "vddk\n";
-    printf "colours-option\n";
-    printf "vdsm-compat-option\n";
-    printf "in-place\n";
-    printf "io/oo\n";
-    printf "mac-option\n";
-    List.iter (printf "input:%s\n") (Modules_list.input_modules ());
-    List.iter (printf "output:%s\n") (Modules_list.output_modules
());
-    List.iter (printf "convert:%s\n") (Modules_list.convert_modules
());
-    List.iter (printf "ovf:%s\n") Create_ovf.ovf_flavours;
+    machine_readable_printf "virt-v2v\n";
+    machine_readable_printf "libguestfs-rewrite\n";
+    machine_readable_printf "vcenter-https\n";
+    machine_readable_printf "xen-ssh\n";
+    machine_readable_printf "vddk\n";
+    machine_readable_printf "colours-option\n";
+    machine_readable_printf "vdsm-compat-option\n";
+    machine_readable_printf "in-place\n";
+    machine_readable_printf "io/oo\n";
+    machine_readable_printf "mac-option\n";
+    List.iter (machine_readable_printf "input:%s\n")
(Modules_list.input_modules ());
+    List.iter (machine_readable_printf "output:%s\n")
(Modules_list.output_modules ());
+    List.iter (machine_readable_printf "convert:%s\n")
(Modules_list.convert_modules ());
+    List.iter (machine_readable_printf "ovf:%s\n")
Create_ovf.ovf_flavours;
     exit 0
   );

--
2.17.1