Pino Toscano
2018-Aug-23 15:13 UTC
[Libguestfs] [PATCH v2 0/2] add output selection for --machine-readable
Hi, this adds the possibility to select the output for --machine-readable in OCaml tools. 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 This makes it possible to add additional output for machine-readable in the tools, with the possibility for users to get it separately from the rest of the output/errors of the tool used. For example, the proposed --print-estimate for virt-v2v [1] could print human output (just like the --print-source), while printing e.g. JSON to the machine-readable stream. [1] https://www.redhat.com/archives/libguestfs/2018-August/msg00158.html Changes from v1: - adjusted the formatting for help text in patch #1 - moved all the machine_readable machinery in Tools_utils - expose all in a single machine_readable () function - add a test - add the documentation bits Thanks, Pino Toscano (2): common/mltools: getopt: add Getopt.OptString OCaml tools: add output selection for --machine-readable .gitignore | 1 + builder/cmdline.ml | 16 +++--- builder/repository_main.ml | 6 ++- builder/virt-builder-repository.pod | 5 ++ builder/virt-builder.pod | 5 ++ common/mlstdutils/std_utils.ml | 4 -- common/mlstdutils/std_utils.mli | 7 +-- common/mltools/Makefile.am | 35 ++++++++++++- common/mltools/getopt-c.c | 20 ++++++- common/mltools/getopt.ml | 26 +++++++-- common/mltools/getopt.mli | 4 ++ common/mltools/getopt_tests.ml | 18 ++++++- common/mltools/machine_readable_tests.ml | 41 +++++++++++++++ common/mltools/test-getopt.sh | 11 ++++ common/mltools/test-machine-readable.sh | 67 ++++++++++++++++++++++++ common/mltools/tools_utils.ml | 53 ++++++++++++++++++- common/mltools/tools_utils.mli | 10 ++++ dib/cmdline.ml | 8 +-- dib/virt-dib.pod | 5 ++ get-kernel/get_kernel.ml | 6 ++- get-kernel/virt-get-kernel.pod | 5 ++ lib/guestfs.pod | 30 +++++++++++ resize/resize.ml | 36 ++++++++----- resize/virt-resize.pod | 5 ++ sparsify/cmdline.ml | 20 +++---- sparsify/copying.ml | 5 +- sparsify/in_place.ml | 5 +- sparsify/virt-sparsify.pod | 5 ++ v2v/cmdline.ml | 32 +++++------ v2v/virt-v2v.pod | 5 ++ 30 files changed, 424 insertions(+), 72 deletions(-) create mode 100644 common/mltools/machine_readable_tests.ml create mode 100755 common/mltools/test-machine-readable.sh -- 2.17.1
Pino Toscano
2018-Aug-23 15:13 UTC
[Libguestfs] [PATCH v2 1/2] common/mltools: getopt: add Getopt.OptString
Introduce a new type of option with an optional string argument.
---
common/mltools/getopt-c.c | 20 +++++++++++++++++++-
common/mltools/getopt.ml | 26 ++++++++++++++++++++++----
common/mltools/getopt.mli | 4 ++++
common/mltools/getopt_tests.ml | 18 +++++++++++++++++-
common/mltools/test-getopt.sh | 11 +++++++++++
5 files changed, 73 insertions(+), 6 deletions(-)
diff --git a/common/mltools/getopt-c.c b/common/mltools/getopt-c.c
index 7b7e39be2..5fa703428 100644
--- a/common/mltools/getopt-c.c
+++ b/common/mltools/getopt-c.c
@@ -274,6 +274,10 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv,
value anon_funv, valu
has_arg = 1;
break;
+ case 8: /* OptString of string * (string option -> unit) */
+ has_arg = 2;
+ break;
+
default:
error (EXIT_FAILURE, 0,
"internal error: unhandled Tag_val (actionv) = %d",
@@ -286,8 +290,11 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv,
value anon_funv, valu
caml_raise_out_of_memory ();
optstring = newstring;
optstring[optstring_len++] = key[0];
- if (has_arg)
+ if (has_arg > 0) {
optstring[optstring_len++] = ':';
+ if (has_arg > 1)
+ optstring[optstring_len++] = ':';
+ }
} else {
struct option *newopts = realloc (longopts, (longopts_len + 1 + 1) *
sizeof (*longopts));
if (newopts == NULL)
@@ -393,6 +400,17 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv,
value anon_funv, valu
do_call1 (v, v2);
break;
+ case 8: /* OptString of string * (string option -> unit) */
+ v = Field (actionv, 1);
+ if (optarg) {
+ v2 = caml_alloc (1, 0);
+ Store_field (v2, 0, caml_copy_string (optarg));
+ } else {
+ v2 = Val_none;
+ }
+ do_call1 (v, v2);
+ break;
+
default:
error (EXIT_FAILURE, 0,
"internal error: unhandled Tag_val (actionv) = %d",
diff --git a/common/mltools/getopt.ml b/common/mltools/getopt.ml
index 9d20855f7..7247f5b6e 100644
--- a/common/mltools/getopt.ml
+++ b/common/mltools/getopt.ml
@@ -31,6 +31,7 @@ type spec | Int of string * (int -> unit)
| Set_int of string * int ref
| Symbol of string * string list * (string -> unit)
+ | OptString of string * (string option -> unit)
module OptionName = struct
type option_name = S of char | L of string | M of string
@@ -92,16 +93,32 @@ let show_help h () match spec with
| Unit _
| Set _
- | Clear _ -> None
+ | Clear _
+ | OptString _ -> None
| String (arg, _)
| Set_string (arg, _)
| Int (arg, _)
| Set_int (arg, _)
| Symbol (arg, _, _) -> Some arg in
- (match arg with
- | None -> ()
- | Some arg ->
+ let optarg + match spec with
+ | Unit _
+ | Set _
+ | Clear _
+ | String _
+ | Set_string _
+ | Int _
+ | Set_int _
+ | Symbol _ -> None
+ | OptString (arg, _) -> Some arg in
+ (match arg, optarg with
+ | None, None -> () (* --foo *)
+ | Some arg, None -> (* --foo=val *)
add (sprintf " <%s>" arg)
+ | None, Some arg -> (* --foo[=val] *)
+ add (sprintf "[=%s]" arg)
+ | Some _, Some _ -> (* should not happen *)
+ failwith "internal error: getopt: option marked both with arg and
optarg"
);
if !columns >= column_wrap then (
Buffer.add_char b '\n';
@@ -181,6 +198,7 @@ let create specs ?anon_fun usage_msg | Set_string _
-> ()
| Int _ -> ()
| Set_int _ -> ()
+ | OptString _ -> ()
| Symbol (_, elements, _) ->
List.iter (
fun e ->
diff --git a/common/mltools/getopt.mli b/common/mltools/getopt.mli
index 2cae19bb8..b4a4f261f 100644
--- a/common/mltools/getopt.mli
+++ b/common/mltools/getopt.mli
@@ -44,6 +44,10 @@ type spec element in the tuple is the documentation
string of the
argument, the second is the list of allowed strings,
and the third is the function to call. *)
+ | OptString of string * (string option -> unit)
+ (** Option with an optional argument; the first element in the
+ tuple is the documentation string of the argument, and the
+ second is the function to call. *)
module OptionName : sig
type option_name diff --git a/common/mltools/getopt_tests.ml
b/common/mltools/getopt_tests.ml
index 751bf1d5f..1617b3056 100644
--- a/common/mltools/getopt_tests.ml
+++ b/common/mltools/getopt_tests.ml
@@ -40,6 +40,15 @@ let set_flag = ref false
let si = ref 42
let ss = ref "not set"
+type optstring_value + | Unset
+ | NoValue
+ | Value of string
+let optstr = ref Unset
+let set_optstr = function
+ | None -> optstr := NoValue
+ | Some s -> optstr := Value s
+
let argspec = [
[ S 'a'; L"add" ], Getopt.String ("string",
add_string), "Add string";
[ S 'c'; L"clear" ], Getopt.Clear clear_flag, "Clear
flag";
@@ -47,10 +56,16 @@ let argspec = [
[ M"ii"; L"set-int" ], Getopt.Set_int ("int",
si), "Set int";
[ M"is"; L"set-string"], Getopt.Set_string
("string", ss), "Set string";
[ S 't'; L"set" ], Getopt.Set set_flag, "Set
flag";
+ [ S 'o'; L"optstr" ], Getopt.OptString ("string",
set_optstr), "Set optional string";
]
let usage_msg = sprintf "%s: test the Getopt parser" prog
+let print_optstring_value = function
+ | Unset -> "not set"
+ | NoValue -> "<none>"
+ | Value s -> s
+
let opthandle = create_standard_options argspec ~anon_fun usage_msg
let () Getopt.parse opthandle;
@@ -66,4 +81,5 @@ let () printf "clear_flag = %b\n" !clear_flag;
printf "set_flag = %b\n" !set_flag;
printf "set_int = %d\n" !si;
- printf "set_string = %s\n" !ss
+ printf "set_string = %s\n" !ss;
+ printf "set_optstring = %s\n" (print_optstring_value !optstr)
diff --git a/common/mltools/test-getopt.sh b/common/mltools/test-getopt.sh
index 9db18fb44..a5e977720 100755
--- a/common/mltools/test-getopt.sh
+++ b/common/mltools/test-getopt.sh
@@ -52,6 +52,7 @@ $t --help | grep -- '-i, --int <int>'
$t --help | grep -- '-ii, --set-int <int>'
$t --help | grep -- '-v, --verbose'
$t --help | grep -- '-x'
+$t --help | grep -F -- '-o, --optstr[=string]'
# --version
$t --version | grep '^getopt_tests 1\.'
@@ -60,6 +61,7 @@ $t --version | grep '^getopt_tests 1\.'
$t --short-options | grep '^-a'
$t --short-options | grep '^-c'
$t --short-options | grep '^-i'
+$t --short-options | grep '^-o'
$t --short-options | grep '^-q'
$t --short-options | grep '^-ii'
$t --short-options | grep '^-is'
@@ -78,6 +80,7 @@ $t --long-options | grep '^--colour'
$t --long-options | grep '^--colours'
$t --long-options | grep '^--debug-gc'
$t --long-options | grep '^--int'
+$t --long-options | grep '^--optstr'
$t --long-options | grep '^--quiet'
$t --long-options | grep '^--set'
$t --long-options | grep '^--set-int'
@@ -157,6 +160,14 @@ $t --set-string B | grep '^set_string = B'
expect_fail $t --is
expect_fail $t --set-string
+# -o/--optstr parameter.
+$t | grep '^set_optstring = not set'
+$t -o | grep '^set_optstring = <none>'
+$t --optstr | grep '^set_optstring = <none>'
+$t -o=A | grep '^set_optstring = A'
+$t --optstr=A | grep '^set_optstring = A'
+$t --optstr=A --optstr | grep '^set_optstring = <none>'
+
# Anonymous parameters.
$t | grep '^anons = \[\]'
$t 1 | grep '^anons = \[1\]'
--
2.17.1
Pino Toscano
2018-Aug-23 15:13 UTC
[Libguestfs] [PATCH v2 2/2] 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 | 1 +
builder/cmdline.ml | 16 +++---
builder/repository_main.ml | 6 ++-
builder/virt-builder-repository.pod | 5 ++
builder/virt-builder.pod | 5 ++
common/mlstdutils/std_utils.ml | 4 --
common/mlstdutils/std_utils.mli | 7 +--
common/mltools/Makefile.am | 35 ++++++++++++-
common/mltools/machine_readable_tests.ml | 41 +++++++++++++++
common/mltools/test-machine-readable.sh | 67 ++++++++++++++++++++++++
common/mltools/tools_utils.ml | 53 ++++++++++++++++++-
common/mltools/tools_utils.mli | 10 ++++
dib/cmdline.ml | 8 +--
dib/virt-dib.pod | 5 ++
get-kernel/get_kernel.ml | 6 ++-
get-kernel/virt-get-kernel.pod | 5 ++
lib/guestfs.pod | 30 +++++++++++
resize/resize.ml | 36 ++++++++-----
resize/virt-resize.pod | 5 ++
sparsify/cmdline.ml | 20 +++----
sparsify/copying.ml | 5 +-
sparsify/in_place.ml | 5 +-
sparsify/virt-sparsify.pod | 5 ++
v2v/cmdline.ml | 32 +++++------
v2v/virt-v2v.pod | 5 ++
25 files changed, 351 insertions(+), 66 deletions(-)
create mode 100644 common/mltools/machine_readable_tests.ml
create mode 100755 common/mltools/test-machine-readable.sh
diff --git a/.gitignore b/.gitignore
index 14c2ddf3b..7bc5c5e20 100644
--- a/.gitignore
+++ b/.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
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 9c854ed49..f05aecc76 100644
--- a/builder/cmdline.ml
+++ b/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. *)
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index 191c210ff..554715a73 100644
--- a/builder/repository_main.ml
+++ b/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. *)
diff --git a/builder/virt-builder-repository.pod
b/builder/virt-builder-repository.pod
index 4ca0c2202..631a680f2 100644
--- a/builder/virt-builder-repository.pod
+++ b/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
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index c82a08b4d..eddadc796 100644
--- a/builder/virt-builder.pod
+++ b/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,
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 6499b3535..df443058f 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/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)
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index cb72fef7d..62cb8e9ff 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/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]
diff --git a/common/mltools/Makefile.am b/common/mltools/Makefile.am
index ac5f53651..995ef2d1c 100644
--- a/common/mltools/Makefile.am
+++ b/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
diff --git a/common/mltools/machine_readable_tests.ml
b/common/mltools/machine_readable_tests.ml
new file mode 100644
index 000000000..907f05207
--- /dev/null
+++ b/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 -> ()
diff --git a/common/mltools/test-machine-readable.sh
b/common/mltools/test-machine-readable.sh
new file mode 100755
index 000000000..1162c58e9
--- /dev/null
+++ b/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
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 920977e42..3daed287b 100644
--- a/common/mltools/tools_utils.ml
+++ b/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
diff --git a/common/mltools/tools_utils.mli b/common/mltools/tools_utils.mli
index c56f7b660..a3b841dc6 100644
--- a/common/mltools/tools_utils.mli
+++ b/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.
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index f5e8ec9cb..5f0cb6dca 100644
--- a/dib/cmdline.ml
+++ b/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
diff --git a/dib/virt-dib.pod b/dib/virt-dib.pod
index 369776173..f6e27ae76 100644
--- a/dib/virt-dib.pod
+++ b/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)
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index f2949da89..c11136adb 100644
--- a/get-kernel/get_kernel.ml
+++ b/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. *)
diff --git a/get-kernel/virt-get-kernel.pod b/get-kernel/virt-get-kernel.pod
index 4939f3501..9aa0b0b1c 100644
--- a/get-kernel/virt-get-kernel.pod
+++ b/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,
diff --git a/lib/guestfs.pod b/lib/guestfs.pod
index 4b24006df..d14b1e4df 100644
--- a/lib/guestfs.pod
+++ b/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 file:F<filename>
+
+The output goes to the specified F<filename>.
+
+=item 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 stream:stderr
+
+The output goes to stderr.
+
+=back
+
=head1 ENVIRONMENT VARIABLES
=over 4
diff --git a/resize/resize.ml b/resize/resize.ml
index 9d2fdaf40..fe1389b6e 100644
--- a/resize/resize.ml
+++ b/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. *)
diff --git a/resize/virt-resize.pod b/resize/virt-resize.pod
index 720318c4d..0461d7652 100644
--- a/resize/virt-resize.pod
+++ b/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."
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index b0af053ac..4ef43a505 100644
--- a/sparsify/cmdline.ml
+++ b/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 diff --git a/sparsify/copying.ml b/sparsify/copying.ml
index a4bfcaa2a..a33b91e69 100644
--- a/sparsify/copying.ml
+++ b/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
diff --git a/sparsify/in_place.ml b/sparsify/in_place.ml
index 7be8ee3e1..1eaca7024 100644
--- a/sparsify/in_place.ml
+++ b/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
diff --git a/sparsify/virt-sparsify.pod b/sparsify/virt-sparsify.pod
index 76a532160..f5e5d2395 100644
--- a/sparsify/virt-sparsify.pod
+++ b/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.
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 10cbb90e6..c61d83f66 100644
--- a/v2v/cmdline.ml
+++ b/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
diff --git a/v2v/virt-v2v.pod b/v2v/virt-v2v.pod
index f1ebe5786..6dcaadfff 100644
--- a/v2v/virt-v2v.pod
+++ b/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
--
2.17.1
Richard W.M. Jones
2018-Aug-23 15:52 UTC
Re: [Libguestfs] [PATCH v2 2/2] OCaml tools: add output selection for --machine-readable
On Thu, Aug 23, 2018 at 05:13:35PM +0200, Pino Toscano wrote:> +=over 4 > + > +=item file:F<filename>Can you bold the literal strings, so: =item B<file:>F<filename> ... =item B<stream:stdout> ... =item B<stream:stderr>> @@ -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 gThis is kind of interesting: Would the progress bar actually want to write to the machine readable channel? Anyway ACK, with the small changes to the man page above. I have some ideas how we could enhance this in future. For example we could add extra fields to the { pr } struct for the channel, alternate functions for writing (eg. write facts), etc. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com Fedora Windows cross-compiler. Compile Windows programs, test, and build Windows installers. Over 100 libraries supported. http://fedoraproject.org/wiki/MinGW
Possibly Parallel Threads
- [PATCH 0/2] RFC: add output selection for --machine-readable
- [PATCH 0/2] RFC: --key option for tools
- [PATCH 1/2] mlstdutils/mltools: factorize the machine-readable option
- [PATCH] common/mltools: getopt: add Getopt.OptString
- [PATCH v2 0/4] OCaml tools: output messages as JSON machine