OCaml tools: add output selection for --machine-readable

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.

.gitignore

@@ -146,6 +146,7 @@ Makefile.in
 /common/mltools/getopt_tests
 /common/mltools/JSON_tests
 /common/mltools/JSON_parser_tests
+/common/mltools/machine_readable_tests
 /common/mltools/tools_utils_tests
 /common/mltools/oUnit-*
 /common/mlutils/.depend

builder/cmdline.ml

@@ -217,14 +217,16 @@ read the man page virt-builder(1).
   let warn_if_partition = !warn_if_partition in
 
   (* 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";
+  (match args, machine_readable () with
+  | [], Some { pr } ->
+    pr "virt-builder\n";
+    pr "arch\n";
+    pr "config-file\n";
+    pr "customize\n";
+    pr "json-list\n";
+    if Pxzcat.using_parallel_xzcat () then pr "pxzcat\n";
     exit 0
+  | _, _ -> ()
   );
 
   (* Check options. *)

builder/repository_main.ml

@@ -74,9 +74,11 @@ read the man page virt-builder-repository(1).
   (* Machine-readable mode?  Print out some facts about what
    * this binary supports.
    *)
-  if machine_readable () then (
-    printf "virt-builder-repository\n";
+  (match machine_readable () with
+  | Some { pr } ->
+    pr "virt-builder-repository\n";
     exit 0
+  | None -> ()
   );
 
   (* Dereference options. *)

builder/virt-builder-repository.pod

@@ -133,6 +133,8 @@ Don’t compress the template images.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -188,6 +190,9 @@ virt-builder-repository binary.  Typical output looks like this:
 A list of features is printed, one per line, and the program exits
 with status 0.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 EXIT STATUS
 
 This program returns 0 if successful, or non-zero if there was an

builder/virt-builder.pod

@@ -369,6 +369,8 @@ See also: I<--source>, I<--notes>, L</SOURCES OF TEMPLATES>.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -1803,6 +1805,9 @@ virt-builder binary.  Typical output looks like this:
 A list of features is printed, one per line, and the program exits
 with status 0.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 ENVIRONMENT VARIABLES
 
 For other environment variables which affect all libguestfs programs,

common/mlstdutils/std_utils.ml

@@ -645,10 +645,6 @@ let verbose = ref false
 let set_verbose () = verbose := true
 let verbose () = !verbose
 
-let machine_readable = ref false
-let set_machine_readable () = machine_readable := true
-let machine_readable () = !machine_readable
-
 let with_open_in filename f =
   let chan = open_in filename in
   protect ~f:(fun () -> f chan) ~finally:(fun () -> close_in chan)

common/mlstdutils/std_utils.mli

@@ -374,11 +374,8 @@ val set_trace : unit -> unit
 val trace : unit -> bool
 val set_verbose : unit -> unit
 val verbose : unit -> bool
-val set_machine_readable : unit -> unit
-val machine_readable : unit -> bool
-(** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]),
-    verbose ([-v]), and machine readable ([--machine-readable]) flags
-    in global variables. *)
+(** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]) and
+    verbose ([-v]) flags in global variables. *)
 
 val with_open_in : string -> (in_channel -> 'a) -> 'a
 (** [with_open_in filename f] calls function [f] with [filename]

common/mltools/Makefile.am

@@ -24,6 +24,7 @@ EXTRA_DIST = \
 	getopt_tests.ml \
 	JSON_tests.ml \
 	JSON_parser_tests.ml \
+	machine_readable_tests.ml \
 	test-getopt.sh \
 	tools_utils_tests.ml
 
@@ -185,6 +186,15 @@ JSON_parser_tests_BOBJECTS = \
 	JSON_parser_tests.cmo
 JSON_parser_tests_XOBJECTS = $(JSON_parser_tests_BOBJECTS:.cmo=.cmx)
 
+machine_readable_tests_SOURCES = dummy.c
+machine_readable_tests_CPPFLAGS = \
+	-I. \
+	-I$(top_builddir) \
+	-I$(shell $(OCAMLC) -where) \
+	-I$(top_srcdir)/lib
+machine_readable_tests_BOBJECTS = machine_readable_tests.cmo
+machine_readable_tests_XOBJECTS = $(machine_readable_tests_BOBJECTS:.cmo=.cmx)
+
 # Can't call the following as <test>_OBJECTS because automake gets confused.
 if !HAVE_OCAMLOPT
 tools_utils_tests_THEOBJECTS = $(tools_utils_tests_BOBJECTS)
@@ -198,6 +208,9 @@ JSON_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
 JSON_parser_tests_THEOBJECTS = $(JSON_parser_tests_BOBJECTS)
 JSON_parser_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+machine_readable_tests_THEOBJECTS = $(machine_readable_tests_BOBJECTS)
+machine_readable_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 else
 tools_utils_tests_THEOBJECTS = $(tools_utils_tests_XOBJECTS)
 tools_utils_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
@@ -210,6 +223,9 @@ JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
 JSON_parser_tests_THEOBJECTS = $(JSON_parser_tests_XOBJECTS)
 JSON_parser_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+machine_readable_tests_THEOBJECTS = $(machine_readable_tests_XOBJECTS)
+machine_readable_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 endif
 
 OCAMLLINKFLAGS = \
@@ -272,12 +288,27 @@ JSON_parser_tests_LINK = \
 	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
 	  $(JSON_parser_tests_THEOBJECTS) -o $@
 
+machine_readable_tests_DEPENDENCIES = \
+	$(machine_readable_tests_THEOBJECTS) \
+	../mlstdutils/mlstdutils.$(MLARCHIVE) \
+	../mlgettext/mlgettext.$(MLARCHIVE) \
+	../mlpcre/mlpcre.$(MLARCHIVE) \
+	$(MLTOOLS_CMA) \
+	$(top_srcdir)/ocaml-link.sh
+machine_readable_tests_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '-lutils -lgnu' -- \
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
+	  $(machine_readable_tests_THEOBJECTS) -o $@
+
 TESTS_ENVIRONMENT = $(top_builddir)/run --test
 
 TESTS = \
-	test-getopt.sh
+	test-getopt.sh \
+	test-machine-readable.sh
 check_PROGRAMS = \
-	getopt_tests
+	getopt_tests \
+	machine_readable_tests
 
 if HAVE_OCAML_PKG_OUNIT
 check_PROGRAMS += JSON_tests JSON_parser_tests tools_utils_tests

common/mltools/machine_readable_tests.ml

@@ -0,0 +1,41 @@
+(*
+ * Copyright (C) 2018 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Test the --machine-readable functionality of the module Tools_utils.
+ * The tests are controlled by the test-machine_readable.sh script.
+ *)
+
+open Printf
+
+open Std_utils
+open Tools_utils
+open Getopt.OptionName
+
+let usage_msg = sprintf "%s: test the --machine-readable functionality" prog
+
+let opthandle = create_standard_options [] ~machine_readable:true usage_msg
+let () =
+  Getopt.parse opthandle;
+
+  print_endline "on-stdout";
+  prerr_endline "on-stderr";
+
+  match machine_readable () with
+  | Some { pr } ->
+    pr "machine-readable\n"
+  | None -> ()

common/mltools/test-machine-readable.sh

@@ -0,0 +1,67 @@
+#!/bin/bash -
+# libguestfs
+# Copyright (C) 2018 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# Test the --machine-readable functionality of the module Tools_utils.
+# See also: machine_readable_tests.ml
+
+set -e
+set -x
+
+$TEST_FUNCTIONS
+skip_if_skipped
+
+t=./machine_readable_tests
+
+tmpdir="$(mktemp -d)"
+mkdir -p "$tmpdir"
+
+# Clean up if the script is killed or exits early.
+cleanup ()
+{
+    status=$?
+    rm -rf "$tmpdir"
+    exit $status
+}
+trap cleanup INT QUIT TERM EXIT ERR
+
+# Program works.
+$t
+
+# No machine-readable output.
+$t | grep 'machine-readable' && test $? = 1
+test $($t | wc -l) -eq 1
+test $($t |& wc -l) -eq 2
+
+# Default output: stdout.
+$t --machine-readable | grep 'machine-readable'
+test $($t --machine-readable | wc -l) -eq 2
+test $($t --machine-readable |& wc -l) -eq 3
+
+# Output "file:".
+fn="$tmpdir/file"
+$t --machine-readable=file:"$fn"
+test $(cat "$fn" | wc -l) -eq 1
+
+# Output "stream:stdout".
+$t --machine-readable=stream:stdout | grep 'machine-readable'
+test $($t --machine-readable=stream:stdout | wc -l) -eq 2
+test $($t --machine-readable=stream:stdout |& wc -l) -eq 3
+
+# Output "stream:stderr".
+$t --machine-readable=stream:stderr 2>&1 >/dev/null | grep 'machine-readable'
+test $($t --machine-readable=stream:stderr 2>&1 >/dev/null | wc -l) -eq 2

common/mltools/tools_utils.ml

@@ -229,10 +229,61 @@ let human_size i =
     )
   )
 
+type machine_readable_fn = {
+  pr : 'a. ('a, unit, string, unit) format4 -> 'a;
+} (* [@@unboxed] *)
+
+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 () =
+  let chan =
+    if !machine_readable_channel = None then (
+      let chan =
+        match !machine_readable_output with
+        | NoOutput -> None
+        | Channel chan -> Some chan
+        | File f -> Some (open_out f) in
+      machine_readable_channel := chan
+    );
+    !machine_readable_channel
+  in
+  match chan with
+  | None -> None
+  | Some chan ->
+    let pr fs =
+      ksprintf (output_string chan) fs
+    in
+    Some { pr }
+
 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
+    | 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
+      )
+  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 +303,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

common/mltools/tools_utils.mli

@@ -64,6 +64,16 @@ val parse_resize : int64 -> string -> int64
 val human_size : int64 -> string
 (** Converts a size in bytes to a human-readable string. *)
 
+type machine_readable_fn = {
+  pr : 'a. ('a, unit, string, unit) format4 -> 'a;
+} (* [@@unboxed] *)
+(** Helper type for {!machine_readable}, used to workaround
+    limitations in returned values. *)
+val machine_readable : unit -> machine_readable_fn option
+(** Returns the printf-like function to use to write all the machine
+    readable output to, in case it was enabled via
+    [--machine-readable]. *)
+
 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.

dib/cmdline.ml

@@ -228,11 +228,13 @@ read the man page virt-dib(1).
   let python = !python in
 
   (* No elements and machine-readable mode?  Print some facts. *)
-  if elements = [] && machine_readable () then (
-    printf "virt-dib\n";
+  (match elements, machine_readable () with
+  | [], Some { pr } ->
+    pr "virt-dib\n";
     let formats_list = Output_format.list_formats () in
-    List.iter (printf "output:%s\n") formats_list;
+    List.iter (pr "output:%s\n") formats_list;
     exit 0
+  | _, _ -> ()
   );
 
   if basepath = "" then

dib/virt-dib.pod

@@ -263,6 +263,8 @@ Set to C<package> to use package based installations by default.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -687,6 +689,9 @@ with status 0.
 The C<output:> features refer to the output formats (I<--formats>
 command line option) supported by this binary.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 TESTING
 
 Virt-dib has been tested with C<diskimage-builder> (and its elements)

get-kernel/get_kernel.ml

@@ -75,9 +75,11 @@ read the man page virt-get-kernel(1).
   (* Machine-readable mode?  Print out some facts about what
    * this binary supports.
    *)
-  if machine_readable () then (
-    printf "virt-get-kernel\n";
+  (match machine_readable () with
+  | Some { pr } ->
+    pr "virt-get-kernel\n";
     exit 0
+  | None -> ()
   );
 
   (* Check -a and -d options. *)

get-kernel/virt-get-kernel.pod

@@ -96,6 +96,8 @@ to try to read passphrases from the user by opening F</dev/tty>.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -170,6 +172,9 @@ virt-get-kernel binary.  Typical output looks like this:
 A list of features is printed, one per line, and the program exits
 with status 0.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 ENVIRONMENT VARIABLES
 
 For other environment variables which affect all libguestfs programs,

lib/guestfs.pod

@@ -3283,6 +3283,36 @@ name.  These are intended to stop a malicious guest from consuming
 arbitrary amounts of memory and disk space on the host, and should not
 be reached in practice.  See the source code for more information.
 
+=head1 ADVANCED MACHINE READABLE OUTPUT
+
+Some of the tools support a I<--machine-readable> option, which is
+generally used to make the output more machine friendly, for easier
+parsing for example.  By default, this output goes to stdout.
+
+In addition to that, a subset of these tools support an extra string
+passed to the I<--machine-readable> option: this string specifies
+where the machine-readable output will go.
+
+The possible values are:
+
+=over 4
+
+=item B<file:>F<filename>
+
+The output goes to the specified F<filename>.
+
+=item B<stream:stdout>
+
+The output goes to stdout.  This is basically the same as the default
+behaviour of I<--machine-readable> with no parameter, although stdout
+as output is specified explicitly.
+
+=item B<stream:stderr>
+
+The output goes to stderr.
+
+=back
+
 =head1 ENVIRONMENT VARIABLES
 
 =over 4

resize/resize.ml

@@ -276,26 +276,28 @@ read the man page virt-resize(1).
      * things added since this option, or things which depend on features
      * 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";
+    (match !disks, machine_readable () with
+    | [], Some { pr } ->
+      pr "virt-resize\n";
+      pr "ntfsresize-force\n";
+      pr "32bitok\n";
+      pr "128-sector-alignment\n";
+      pr "alignment\n";
+      pr "align-first\n";
+      pr "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";
+        pr "ntfs\n";
       if g#feature_available [| "btrfs" |] then
-        printf "btrfs\n";
+        pr "btrfs\n";
       if g#feature_available [| "xfs" |] then
-        printf "xfs\n";
+        pr "xfs\n";
       if g#feature_available [| "f2fs" |] then
-        printf "f2fs\n";
+        pr "f2fs\n";
       exit 0
+    | _, _ -> ()
     );
 
     (* Verify we got exactly 2 disks. *)
@@ -353,7 +355,10 @@ read the man page virt-resize(1).
     (* The output disk is being created, so use cache=unsafe here. *)
     add_drive_uri g ?format:output_format ~readonly:false ~cachemode:"unsafe"
       (snd outfile);
-    if not (quiet ()) then Progress.set_up_progress_bar ~machine_readable:(machine_readable ()) g;
+    if not (quiet ()) then (
+      let machine_readable = machine_readable () <> None in
+      Progress.set_up_progress_bar ~machine_readable g
+    );
     g#launch ();
 
     (* Set the filter to /dev/sda, in case there are any rogue
@@ -1331,7 +1336,10 @@ read the man page virt-resize(1).
       (* The output disk is being created, so use cache=unsafe here. *)
       add_drive_uri g ?format:output_format ~readonly:false ~cachemode:"unsafe"
         (snd outfile);
-      if not (quiet ()) then Progress.set_up_progress_bar ~machine_readable:(machine_readable ()) g;
+      if not (quiet ()) then (
+        let machine_readable = machine_readable () <> None in
+        Progress.set_up_progress_bar ~machine_readable g
+      );
       g#launch ();
 
       g (* Return new handle. *)

resize/virt-resize.pod

@@ -461,6 +461,8 @@ are all in different volume groups.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -687,6 +689,9 @@ if there was a fatal error.
 Versions of the program prior to 1.13.9 did not support the
 I<--machine-readable> option and will return an error.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 NOTES
 
 =head2 "Partition 1 does not end on cylinder boundary."

sparsify/cmdline.ml

@@ -106,21 +106,23 @@ read the man page virt-sparsify(1).
   (* No arguments and machine-readable mode?  Print out some facts
    * 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";
+  (match disks, machine_readable () with
+  | [], Some { pr } ->
+    pr "virt-sparsify\n";
+    pr "linux-swap\n";
+    pr "zero\n";
+    pr "check-tmpdir\n";
+    pr "in-place\n";
+    pr "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";
+      pr "ntfs\n";
     if g#feature_available [| "btrfs" |] then
-      printf "btrfs\n";
+      pr "btrfs\n";
     exit 0
+  | _, _ -> ()
   );
 
   let indisk, mode =

sparsify/copying.ml

@@ -179,7 +179,10 @@ You can ignore this warning or change it to a hard failure using the
     (* Note that the temporary overlay disk is always qcow2 format. *)
     g#add_drive ~format:"qcow2" ~readonly:false ~cachemode:"unsafe" overlaydisk;
 
-    if not (quiet ()) then Progress.set_up_progress_bar ~machine_readable:(machine_readable ()) g;
+    if not (quiet ()) then (
+      let machine_readable = machine_readable () <> None in
+      Progress.set_up_progress_bar ~machine_readable g
+    );
     g#launch ();
 
     g in

sparsify/in_place.ml

@@ -49,7 +49,10 @@ let run disk format ignores zeroes =
 
   g#add_drive ?format ~discard:"enable" disk;
 
-  if not (quiet ()) then Progress.set_up_progress_bar ~machine_readable:(machine_readable ()) g;
+  if not (quiet ()) then (
+    let machine_readable = machine_readable () <> None in
+    Progress.set_up_progress_bar ~machine_readable g
+  );
   g#launch ();
 
   (* If discard is not supported in the appliance, we must return exit

sparsify/virt-sparsify.pod

@@ -237,6 +237,8 @@ to try to read passphrases from the user by opening F</dev/tty>.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -400,6 +402,9 @@ code if there was a fatal error.
 All versions of virt-sparsify have supported the I<--machine-readable>
 option.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 WINDOWS 8
 
 Windows 8 "fast startup" can prevent virt-sparsify from working.

v2v/cmdline.ml

@@ -333,22 +333,24 @@ read the man page virt-v2v(1).
   (* No arguments and machine-readable mode?  Print out some facts
    * 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;
+  (match args, machine_readable () with
+  | [], Some { pr } ->
+    pr "virt-v2v\n";
+    pr "libguestfs-rewrite\n";
+    pr "vcenter-https\n";
+    pr "xen-ssh\n";
+    pr "vddk\n";
+    pr "colours-option\n";
+    pr "vdsm-compat-option\n";
+    pr "in-place\n";
+    pr "io/oo\n";
+    pr "mac-option\n";
+    List.iter (pr "input:%s\n") (Modules_list.input_modules ());
+    List.iter (pr "output:%s\n") (Modules_list.output_modules ());
+    List.iter (pr "convert:%s\n") (Modules_list.convert_modules ());
+    List.iter (pr "ovf:%s\n") Create_ovf.ovf_flavours;
     exit 0
+  | _, _ -> ()
   );
 
   (* Input transport affects whether some input options should or

v2v/virt-v2v.pod

@@ -479,6 +479,8 @@ See L</NETWORKS AND BRIDGES> below.
 
 =item B<--machine-readable>
 
+=item B<--machine-readable>=format
+
 This option is used to make the output more machine friendly
 when being parsed by other programs.  See
 L</MACHINE READABLE OUTPUT> below.
@@ -2504,6 +2506,9 @@ code if there was a fatal error.
 Virt-v2v E<le> 0.9.1 did not support the I<--machine-readable>
 option at all.  The option was added when virt-v2v was rewritten in 2014.
 
+It is possible to specify a format string for controlling the output;
+see L<guestfs(3)/ADVANCED MACHINE READABLE OUTPUT>.
+
 =head1 FILES
 
 =over 4