[PATCH v5 0/2] RFE: journal reader in guestfish
by Maros Zatko
There seems to be a minor issue when user wants to run it through pager (more)
and wants cancel it. User will end up with stuck guestfish until journal-view
transfers all journal items.
Output is configurable, it's the same format as virt-log has, since both
uses same code.
Maros Zatko (2):
cat: move get_journal_field to fish/journal.c
fish: add journal-view command (RHBZ#988100)
cat/Makefile.am | 1 +
cat/log.c | 114 ++--------------------------------------
fish/Makefile.am | 1 +
fish/journal.c | 141 ++++++++++++++++++++++++++++++++++++++++++++++++++
generator/Makefile.am | 6 ++-
generator/actions.ml | 22 ++++++++
generator/journal.ml | 97 ++++++++++++++++++++++++++++++++++
generator/main.ml | 3 ++
8 files changed, 272 insertions(+), 113 deletions(-)
create mode 100644 fish/journal.c
create mode 100644 generator/journal.ml
--
1.9.3
8 years, 8 months
- 2
- 5
[PATCH 1/3] get-kernel: split command line handling in own function
by Pino Toscano
Simple refactoring, no actual behaviour changes.
---
get-kernel/get_kernel.ml | 188 ++++++++++++++++++++++++-----------------------
1 file changed, 95 insertions(+), 93 deletions(-)
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 8ca7ca0..3b27740 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -23,104 +23,106 @@ module G = Guestfs
open Printf
-(* Main program. *)
-let main () =
- let add, output, unversioned, prefix =
- let domain = ref None in
- let file = ref None in
- let libvirturi = ref "" in
- let format = ref "" in
- let output = ref "" in
- let machine_readable = ref false in
- let unversioned = ref false in
- let prefix = ref None in
-
- let set_file arg =
- if !file <> None then
- error (f_"--add option can only be given once");
- let uri =
- try URI.parse_uri arg
- with Invalid_argument "URI.parse_uri" ->
- error (f_"error parsing URI '%s'. Look for error messages printed above.") arg in
- file := Some uri
- and set_domain dom =
- if !domain <> None then
- error (f_"--domain option can only be given once");
- domain := Some dom
- and set_prefix p =
- if !prefix <> None then
- error (f_"--prefix option can only be given once");
- prefix := Some p in
-
- let ditto = " -\"-" in
- let argspec = [
- "-a", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
- "--add", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
- "-c", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
- "--connect", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
- "-d", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
- "--domain", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
- "--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
- "--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
- "-o", Arg.Set_string output, s_"directory" ^ " " ^ s_"Output directory";
- "--output", Arg.Set_string output, ditto;
- "--unversioned-names", Arg.Set unversioned,
- " " ^ s_"Use unversioned names for files";
- "--prefix", Arg.String set_prefix, "prefix" ^ " " ^ s_"Prefix for files";
- ] in
- let argspec = set_standard_options argspec in
- let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command line")) in
- let usage_msg =
- sprintf (f_"\
+let parse_cmdline () =
+ let domain = ref None in
+ let file = ref None in
+ let libvirturi = ref "" in
+ let format = ref "" in
+ let output = ref "" in
+ let machine_readable = ref false in
+ let unversioned = ref false in
+ let prefix = ref None in
+
+ let set_file arg =
+ if !file <> None then
+ error (f_"--add option can only be given once");
+ let uri =
+ try URI.parse_uri arg
+ with Invalid_argument "URI.parse_uri" ->
+ error (f_"error parsing URI '%s'. Look for error messages printed above.") arg in
+ file := Some uri
+ and set_domain dom =
+ if !domain <> None then
+ error (f_"--domain option can only be given once");
+ domain := Some dom
+ and set_prefix p =
+ if !prefix <> None then
+ error (f_"--prefix option can only be given once");
+ prefix := Some p in
+
+ let ditto = " -\"-" in
+ let argspec = [
+ "-a", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
+ "--add", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
+ "-c", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
+ "--connect", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
+ "-d", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
+ "--domain", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
+ "--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
+ "--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
+ "-o", Arg.Set_string output, s_"directory" ^ " " ^ s_"Output directory";
+ "--output", Arg.Set_string output, ditto;
+ "--unversioned-names", Arg.Set unversioned,
+ " " ^ s_"Use unversioned names for files";
+ "--prefix", Arg.String set_prefix, "prefix" ^ " " ^ s_"Prefix for files";
+ ] in
+ let argspec = set_standard_options argspec in
+ let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command line")) in
+ let usage_msg =
+ sprintf (f_"\
%s: extract kernel and ramdisk from a guest
A short summary of the options is given below. For detailed help please
read the man page virt-get-kernel(1).
")
- prog in
- Arg.parse argspec anon_fun usage_msg;
-
- (* Machine-readable mode? Print out some facts about what
- * this binary supports.
- *)
- if !machine_readable then (
- printf "virt-get-kernel\n";
- exit 0
- );
-
- (* Check -a and -d options. *)
- let file = !file in
- let domain = !domain in
- let libvirturi = match !libvirturi with "" -> None | s -> Some s in
- let add =
- match file, domain with
- | None, None ->
- error (f_"you must give either -a or -d options. Read virt-get-kernel(1) man page for further information.")
- | Some _, Some _ ->
- error (f_"you cannot give -a and -d options together. Read virt-get-kernel(1) man page for further information.")
- | None, Some dom ->
- fun (g : Guestfs.guestfs) ->
- let readonlydisk = "ignore" (* ignore CDs, data drives *) in
- ignore (g#add_domain
- ~readonly:true ~allowuuid:true ~readonlydisk
- ?libvirturi dom)
- | Some uri, None ->
- fun g ->
- let { URI.path = path; protocol = protocol;
- server = server; username = username;
- password = password } = uri in
- let format = match !format with "" -> None | s -> Some s in
- g#add_drive
- ~readonly:true ?format ~protocol ?server ?username ?secret:password
- path
- in
-
- (* Dereference the rest of the args. *)
- let output = match !output with "" -> None | str -> Some str in
- let unversioned = !unversioned in
- let prefix = !prefix in
-
- add, output, unversioned, prefix in
+ prog in
+ Arg.parse argspec anon_fun usage_msg;
+
+ (* Machine-readable mode? Print out some facts about what
+ * this binary supports.
+ *)
+ if !machine_readable then (
+ printf "virt-get-kernel\n";
+ exit 0
+ );
+
+ (* Check -a and -d options. *)
+ let file = !file in
+ let domain = !domain in
+ let libvirturi = match !libvirturi with "" -> None | s -> Some s in
+ let add =
+ match file, domain with
+ | None, None ->
+ error (f_"you must give either -a or -d options. Read virt-get-kernel(1) man page for further information.")
+ | Some _, Some _ ->
+ error (f_"you cannot give -a and -d options together. Read virt-get-kernel(1) man page for further information.")
+ | None, Some dom ->
+ fun (g : Guestfs.guestfs) ->
+ let readonlydisk = "ignore" (* ignore CDs, data drives *) in
+ ignore (g#add_domain
+ ~readonly:true ~allowuuid:true ~readonlydisk
+ ?libvirturi dom)
+ | Some uri, None ->
+ fun g ->
+ let { URI.path = path; protocol = protocol;
+ server = server; username = username;
+ password = password } = uri in
+ let format = match !format with "" -> None | s -> Some s in
+ g#add_drive
+ ~readonly:true ?format ~protocol ?server ?username ?secret:password
+ path
+ in
+
+ (* Dereference the rest of the args. *)
+ let output = match !output with "" -> None | str -> Some str in
+ let unversioned = !unversioned in
+ let prefix = !prefix in
+
+ add, output, unversioned, prefix
+
+(* Main program. *)
+let main () =
+ let add, output, unversioned, prefix = parse_cmdline () in
(* Connect to libguestfs. *)
let g = new G.guestfs () in
--
2.1.0
8 years, 8 months
- 2
- 3
[PATCH 1/3] mllib: make few command line options stuff private
by Pino Toscano
Make print_version_and_exit, long_options, display_short_options, and
display_long_options private, as set_standard_options now takes care of
handling the job for the common command line options.
---
mllib/common_utils.mli | 10 ----------
1 file changed, 10 deletions(-)
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 79032bc..24f8f83 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -90,10 +90,6 @@ val info : ('a, unit, string, unit) format4 -> 'a
val run_main_and_handle_errors : (unit -> unit) -> unit
(** Common function for handling pretty-printing exceptions. *)
-val print_version_and_exit : unit -> unit
-(** Print the version number and exit. Implements [--version] flag in
- the OCaml tools. *)
-
val generated_by : string
(** The string "generated by <prog> <version>". *)
@@ -116,12 +112,6 @@ val skip_dashes : string -> string
val compare_command_line_args : string -> string -> int
(** Compare command line arguments for equality, ignoring any leading [-]s. *)
-val long_options : (Arg.key * Arg.spec * Arg.doc) list ref
-val display_short_options : unit -> 'a
-(** Implements [--short-options]. *)
-val display_long_options : unit -> 'a
-(** Implements [--long-options]. *)
-
val set_standard_options : (Arg.key * Arg.spec * Arg.doc) list -> (Arg.key * Arg.spec * Arg.doc) list
(** Adds the standard libguestfs command line options to the specified ones,
sorting them, and setting [long_options] to them.
--
2.1.0
8 years, 8 months
- 2
- 3
[PATCH 1/2] mllib: add and use set_standard_options
by Pino Toscano
Introduce a new common helper to add the common options for libguestfs
tools (short/long options, version, verbose, trace), and sort them.
All the OCaml-based tools had these options already, so there are no
functional changes in the interface they provide.
The only difference is that now the options are always sorted, while
some tools didn't had them like that previously: because of this, a
couple of ditto markers (as descriptions) don't match what's above them
anymore, and thus their full description is put instead.
---
builder/cmdline.ml | 18 +-----------------
customize/customize_main.ml | 18 +-----------------
dib/cmdline.ml | 17 +----------------
get-kernel/get_kernel.ml | 12 ++----------
mllib/common_utils.ml | 19 +++++++++++++++++++
mllib/common_utils.mli | 6 ++++++
resize/resize.ml | 14 +++-----------
sparsify/cmdline.ml | 12 ++----------
sysprep/main.ml | 14 +-------------
v2v/cmdline.ml | 14 +++-----------
10 files changed, 39 insertions(+), 105 deletions(-)
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 49435ae..1537208 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -126,8 +126,6 @@ let parse_cmdline () =
"--long", Arg.Unit list_set_long, " " ^ s_"Shortcut for --list-format short";
"--list-format", Arg.String list_set_format,
"short|long|json" ^ " " ^ s_"Set the format for --list (default: short)";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
"-m", Arg.Int set_memsize, "mb" ^ " " ^ s_"Set memory size";
"--memsize", Arg.Int set_memsize, "mb" ^ " " ^ s_"Set memory size";
@@ -143,26 +141,12 @@ let parse_cmdline () =
"--smp", Arg.Int set_smp, "vcpus" ^ " " ^ s_"Set number of vCPUs";
"--source", Arg.String add_source, "URL" ^ " " ^ s_"Set source URL";
"--no-sync", Arg.Clear sync, " " ^ s_"Do not fsync output file on exit";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
let customize_argspec =
List.map (fun (spec, _, _) -> spec) customize_argspec in
let argspec = argspec @ customize_argspec in
- let argspec =
- let cmp (arg1, _, _) (arg2, _, _) =
- let arg1 = skip_dashes arg1 and arg2 = skip_dashes arg2 in
- compare (String.lowercase arg1) (String.lowercase arg2)
- in
- List.sort cmp argspec in
- let argspec = Arg.align argspec in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let args = ref [] in
let anon_fun s = args := s :: !args in
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 03c97e4..459e98a 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -85,8 +85,6 @@ let main () =
"--dryrun", Arg.Set dryrun, " " ^ s_"Perform a dry run";
"--dry-run", Arg.Set dryrun, " " ^ s_"Perform a dry run";
"--format", Arg.String set_format, s_"format" ^ " " ^ s_"Set format (default: auto)";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
"-m", Arg.Int set_memsize, "mb" ^ " " ^ s_"Set memory size";
"--memsize", Arg.Int set_memsize, "mb" ^ " " ^ s_"Set memory size";
"--network", Arg.Set network, " " ^ s_"Enable appliance network (default)";
@@ -94,27 +92,13 @@ let main () =
"-q", Arg.Unit set_quiet, " " ^ s_"Don't print log messages";
"--quiet", Arg.Unit set_quiet, " " ^ s_"Don't print log messages";
"--smp", Arg.Int set_smp, "vcpus" ^ " " ^ s_"Set number of vCPUs";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let customize_argspec, get_customize_ops =
Customize_cmdline.argspec () in
let customize_argspec =
List.map (fun (spec, _, _) -> spec) customize_argspec in
let argspec = argspec @ customize_argspec in
- let argspec =
- let cmp (arg1, _, _) (arg2, _, _) =
- let arg1 = skip_dashes arg1 and arg2 = skip_dashes arg2 in
- compare (String.lowercase arg1) (String.lowercase arg2)
- in
- List.sort cmp argspec in
- let argspec = Arg.align argspec in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command line")) in
let usage_msg =
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 2fe77da..e2f2ded 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -126,9 +126,6 @@ read the man page virt-dib(1).
extra_packages := List.rev (string_nsplit "," arg) @ !extra_packages in
let argspec = [
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
-
"-p", Arg.String append_element_path, "path" ^ " " ^ s_"Add new a elements location";
"--element-path", Arg.String append_element_path, "path" ^ " " ^ s_"Add new a elements location";
"--exclude-element", Arg.String append_excluded_element,
@@ -167,23 +164,11 @@ read the man page virt-dib(1).
" " ^ s_"Don't delete output file on failure";
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
- "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
- "--verbose", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
"--debug", Arg.Int set_debug, "level" ^ " " ^ s_"Set debug level";
"-B", Arg.Set_string basepath, "path" ^ " " ^ s_"Base path of diskimage-builder library";
] in
- let argspec =
- let cmp (arg1, _, _) (arg2, _, _) =
- let arg1 = skip_dashes arg1 and arg2 = skip_dashes arg2 in
- compare (String.lowercase arg1) (String.lowercase arg2)
- in
- List.sort cmp argspec in
- let argspec = Arg.align argspec in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
Arg.parse argspec append_element usage_msg;
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 58193ab..8ca7ca0 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -53,7 +53,7 @@ let main () =
prefix := Some p in
let ditto = " -\"-" in
- let argspec = Arg.align [
+ let argspec = [
"-a", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
"--add", Arg.String set_file, s_"file" ^ " " ^ s_"Add disk image file";
"-c", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
@@ -61,22 +61,14 @@ let main () =
"-d", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"--domain", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
"-o", Arg.Set_string output, s_"directory" ^ " " ^ s_"Output directory";
"--output", Arg.Set_string output, ditto;
"--unversioned-names", Arg.Set unversioned,
" " ^ s_"Use unversioned names for files";
"--prefix", Arg.String set_prefix, "prefix" ^ " " ^ s_"Prefix for files";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, ditto;
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit, ditto;
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command line")) in
let usage_msg =
sprintf (f_"\
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 99d2098..2b7d88d 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -510,6 +510,25 @@ let display_long_options () =
) !long_options;
exit 0
+let set_standard_options argspec =
+ let argspec = [
+ "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
+ "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
+ "-V", Arg.Unit print_version_and_exit,
+ " " ^ s_"Display version and exit";
+ "--version", Arg.Unit print_version_and_exit,
+ " " ^ s_"Display version and exit";
+ "-v", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
+ "--verbose", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
+ "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
+ ] @ argspec in
+ let argspec =
+ let cmp (arg1, _, _) (arg2, _, _) = compare_command_line_args arg1 arg2 in
+ List.sort cmp argspec in
+ let argspec = Arg.align argspec in
+ long_options := argspec;
+ argspec
+
(* Compare two version strings intelligently. *)
let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$"
let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$"
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 9d1ee6a..5d93b53 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -122,6 +122,12 @@ val display_short_options : unit -> 'a
val display_long_options : unit -> 'a
(** Implements [--long-options]. *)
+val set_standard_options : (Arg.key * Arg.spec * Arg.doc) list -> (Arg.key * Arg.spec * Arg.doc) list
+(** Adds the standard libguestfs command line options to the specified ones,
+ sorting them, and setting [long_options] to them.
+
+ Returns the resulting options. *)
+
val compare_version : string -> string -> int
(** Compare two version strings. *)
diff --git a/resize/resize.ml b/resize/resize.ml
index 8ab14f7..f353158 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -189,7 +189,7 @@ let main () =
let sparse = ref true in
let ditto = " -\"-" in
- let argspec = Arg.align [
+ let argspec = [
"--align-first", Arg.Set_string align_first, s_"never|always|auto" ^ " " ^ s_"Align first partition (default: auto)";
"--alignment", Arg.Set_int alignment, s_"sectors" ^ " " ^ s_"Set partition alignment (default: 128 sectors)";
"--no-copy-boot-loader", Arg.Clear copy_boot_loader, " " ^ s_"Don't copy boot loader";
@@ -202,16 +202,14 @@ let main () =
"--no-extra-partition", Arg.Clear extra_partition, " " ^ s_"Don't create extra partition";
"--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
"--ignore", Arg.String (add ignores), s_"part" ^ " " ^ s_"Ignore partition";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--lv-expand", Arg.String (add lv_expands), s_"lv" ^ " " ^ s_"Expand logical volume";
"--LV-expand", Arg.String (add lv_expands), s_"lv" ^ ditto;
"--lvexpand", Arg.String (add lv_expands), s_"lv" ^ ditto;
"--LVexpand", Arg.String (add lv_expands), s_"lv" ^ ditto;
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
"-n", Arg.Set dryrun, " " ^ s_"Don't perform changes";
+ "--dry-run", Arg.Set dryrun, " " ^ s_"Don't perform changes";
"--dryrun", Arg.Set dryrun, ditto;
- "--dry-run", Arg.Set dryrun, ditto;
"--ntfsresize-force", Arg.Set ntfsresize_force, " " ^ s_"Force ntfsresize";
"--output-format", Arg.Set_string output_format, s_"format" ^ " " ^ s_"Format of output disk";
"-q", Arg.Unit set_quiet, " " ^ s_"Don't print the summary";
@@ -220,14 +218,8 @@ let main () =
"--resize-force", Arg.String (add resizes_force), s_"part=size" ^ " " ^ s_"Forcefully resize partition";
"--shrink", Arg.String set_shrink, s_"part" ^ " " ^ s_"Shrink partition";
"--no-sparse", Arg.Clear sparse, " " ^ s_"Turn off sparse copying";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, ditto;
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit, ditto;
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let disks = ref [] in
let anon_fun s = disks := s :: !disks in
let usage_msg =
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index b2a57c3..8cd26a4 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -55,7 +55,7 @@ let parse_cmdline () =
let zeroes = ref [] in
let ditto = " -\"-" in
- let argspec = Arg.align [
+ let argspec = [
"--check-tmpdir", Arg.String set_check_tmpdir, "ignore|..." ^ " " ^ s_"Check there is enough space in $TMPDIR";
"--compress", Arg.Set compress, " " ^ s_"Compressed output format";
"--convert", Arg.Set_string convert, s_"format" ^ " " ^ s_"Format of output disk (default: same as input)";
@@ -64,22 +64,14 @@ let parse_cmdline () =
"--ignore", Arg.String (add ignores), s_"fs" ^ " " ^ s_"Ignore filesystem";
"--in-place", Arg.Set in_place, " " ^ s_"Modify the disk image in-place";
"--inplace", Arg.Set in_place, ditto;
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
"-o", Arg.Set_string option, s_"option" ^ " " ^ s_"Add qemu-img options";
"-q", Arg.Unit set_quiet, " " ^ s_"Quiet output";
"--quiet", Arg.Unit set_quiet, ditto;
"--tmp", Arg.Set_string tmp, s_"block|dir|prebuilt:file" ^ " " ^ s_"Set temporary block device, directory or prebuilt file";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, ditto;
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit, ditto;
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
"--zero", Arg.String (add zeroes), s_"fs" ^ " " ^ s_"Zero filesystem";
] in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let disks = ref [] in
let anon_fun s = disks := s :: !disks in
let usage_msg =
diff --git a/sysprep/main.ml b/sysprep/main.ml
index 8b71109..c9fe2ea 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -131,8 +131,6 @@ let main () =
"--enable", Arg.String set_enable, s_"operations" ^ " " ^ s_"Enable specific operations";
"--format", Arg.String set_format, s_"format" ^ " " ^ s_"Set format (default: auto)";
"--list-operations", Arg.Unit list_operations, " " ^ s_"List supported operations";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--mount-options", Arg.Set_string mount_opts, s_"opts" ^ " " ^ s_"Set mount options (eg /:noatime;/var:rw,noatime)";
"--no-selinux-relabel", Arg.Unit (fun () -> ()),
" " ^ s_"Compatibility option, does nothing";
@@ -140,19 +138,9 @@ let main () =
"--operations", Arg.String set_operations, " " ^ s_"Enable/disable specific operations";
"-q", Arg.Unit set_quiet, " " ^ s_"Don't print log messages";
"--quiet", Arg.Unit set_quiet, " " ^ s_"Don't print log messages";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let args = basic_args @ Sysprep_operation.extra_args () in
- let args =
- List.sort (fun (a,_,_) (b,_,_) -> compare_command_line_args a b) args in
- let argspec = Arg.align args in
- long_options := argspec;
+ let argspec = set_standard_options args in
let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command line")) in
let usage_msg =
sprintf (f_"\
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index df65426..0a0349c 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -134,7 +134,7 @@ let parse_cmdline () =
String.concat "|" (Modules_list.output_modules ()) in
let ditto = " -\"-" in
- let argspec = Arg.align [
+ let argspec = [
"-b", Arg.String add_bridge, "in:out " ^ s_"Map bridge 'in' to 'out'";
"--bridge", Arg.String add_bridge, "in:out " ^ ditto;
"--debug-gc",Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations";
@@ -146,8 +146,6 @@ let parse_cmdline () =
"-ic", Arg.Set_string input_conn, "uri " ^ s_"Libvirt URI";
"-if", Arg.Set_string input_format,
"format " ^ s_"Input format (for -i disk)";
- "--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
- "--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
"-n", Arg.String add_network, "in:out " ^ s_"Map network 'in' to 'out'";
"--network", Arg.String add_network, "in:out " ^ ditto;
@@ -163,7 +161,7 @@ let parse_cmdline () =
"--print-source", Arg.Set print_source, " " ^ s_"Print source and stop";
"--qemu-boot", Arg.Set qemu_boot, " " ^ s_"Boot in qemu (-o qemu only)";
"-q", Arg.Unit set_quiet, " " ^ s_"Quiet output";
- "--quiet", Arg.Unit set_quiet, ditto;
+ "--quiet", Arg.Unit set_quiet, " " ^ s_"Quiet output";
"--root", Arg.String set_root_choice,"ask|... " ^ s_"How to choose root filesystem";
"--vdsm-image-uuid",
Arg.String add_vdsm_image_uuid, "uuid " ^ s_"Output image UUID(s)";
@@ -173,15 +171,9 @@ let parse_cmdline () =
Arg.Set_string vdsm_vm_uuid, "uuid " ^ s_"Output VM UUID";
"--vdsm-ovf-output",
Arg.Set_string vdsm_ovf_output, " " ^ s_"Output OVF file";
- "-v", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Unit set_verbose, ditto;
- "-V", Arg.Unit print_version_and_exit,
- " " ^ s_"Display version and exit";
- "--version", Arg.Unit print_version_and_exit, ditto;
"--vmtype", Arg.Set_string vmtype, "server|desktop " ^ s_"Set vmtype (for RHEV)";
- "-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
- long_options := argspec;
+ let argspec = set_standard_options argspec in
let args = ref [] in
let anon_fun s = args := s :: !args in
let usage_msg =
--
2.1.0
8 years, 8 months
- 2
- 3