5:46 a.m.
v1 -> v2:
- Further fixes to Getopt int parsing.
- Completed the L/S changes.
- Fixed the test suite so it passes now. Also we don't need the
special-case tests for 64 bit arch.
Rich.
5:46 a.m.
New subject: [PATCH v2 1/3] mllib: getopt: Further fix int parsing.
Don't allow suffixes on integers, and fix the bounds to match the
definitions of Min_long and Max_long in <caml/mlvalues.h>.
Fixes commit 66b54bfefe42f2996d1b42c3646511bbd4349317.
---
mllib/getopt-c.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c
index bf40f91..13852c2 100644
--- a/mllib/getopt-c.c
+++ b/mllib/getopt-c.c
@@ -124,13 +124,13 @@ strtoint (const char *arg)
{
long int num;
- if (xstrtol (arg, NULL, 0, &num, NULL) != LONGINT_OK) {
+ if (xstrtol (arg, NULL, 0, &num, "") != LONGINT_OK) {
fprintf (stderr, _("%s: '%s' is not a numeric value.\n"),
guestfs_int_program_name, arg);
show_error (EXIT_FAILURE);
}
- if (num <= -(2LL<<30) || num >= ((2LL<<30)-1)) {
+ if (num < -(1<<30) || num > (1<<30)-1) {
fprintf (stderr, _("%s: %s: integer out of range\n"),
guestfs_int_program_name, arg);
show_error (EXIT_FAILURE);
--
2.7.4
5:46 a.m.
New subject: [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.
---
builder/cmdline.ml | 61 +++++++--------
dib/cmdline.ml | 57 +++++++-------
generator/customize.ml | 29 +++----
get-kernel/get_kernel.ml | 17 +++--
mllib/common_utils.ml | 15 ++--
mllib/getopt.ml | 121 +++++++++++++++---------------
mllib/getopt.mli | 43 ++++++-----
resize/resize.ml | 41 +++++-----
sparsify/cmdline.ml | 21 +++---
sysprep/main.ml | 29 +++----
sysprep/sysprep_operation.ml | 8 +-
sysprep/sysprep_operation_script.ml | 5 +-
sysprep/sysprep_operation_user_account.ml | 5 +-
v2v/cmdline.ml | 55 +++++++-------
v2v/copy_to_local.ml | 5 +-
15 files changed, 267 insertions(+), 245 deletions(-)
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 846c2e3..49a57ee 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -20,6 +20,7 @@
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Customize_cmdline
@@ -119,46 +120,46 @@ let parse_cmdline () =
let warn_if_partition = ref true in
let argspec = [
- [ "--arch" ], Getopt.Set_string ("arch", arch),
s_"Set the output architecture";
- [ "--attach" ], Getopt.String ("iso", attach_disk),
s_"Attach data disk/ISO during install";
- [ "--attach-format" ], Getopt.String ("format",
set_attach_format),
+ [ L"arch" ], Getopt.Set_string ("arch", arch),
s_"Set the output architecture";
+ [ L"attach" ], Getopt.String ("iso", attach_disk),
s_"Attach data disk/ISO during install";
+ [ L"attach-format" ], Getopt.String ("format",
set_attach_format),
s_"Set attach disk format";
- [ "--cache" ], Getopt.String ("dir", set_cache),
s_"Set template cache dir";
- [ "--no-cache" ], Getopt.Unit no_cache, s_"Disable template
cache";
- [ "--cache-all-templates" ], Getopt.Unit cache_all_mode,
+ [ L"cache" ], Getopt.String ("dir", set_cache),
s_"Set template cache dir";
+ [ L"no-cache" ], Getopt.Unit no_cache, s_"Disable template
cache";
+ [ L"cache-all-templates" ], Getopt.Unit cache_all_mode,
s_"Download all templates to the
cache";
- [ "--check-signature"; "--check-signatures" ], Getopt.Set
check_signature,
+ [ L"check-signature"; L"check-signatures" ], Getopt.Set
check_signature,
s_"Check digital signatures";
- [ "--no-check-signature"; "--no-check-signatures" ], Getopt.Clear
check_signature,
+ [ L"no-check-signature"; L"no-check-signatures" ], Getopt.Clear
check_signature,
s_"Disable digital signatures";
- [ "--curl" ], Getopt.Set_string ("curl", curl),
s_"Set curl binary/command";
- [ "--delete-cache" ], Getopt.Unit delete_cache_mode,
+ [ L"curl" ], Getopt.Set_string ("curl", curl),
s_"Set curl binary/command";
+ [ L"delete-cache" ], Getopt.Unit delete_cache_mode,
s_"Delete the template cache";
- [ "--no-delete-on-failure" ], Getopt.Clear delete_on_failure,
+ [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure,
s_"Don't delete output file on
failure";
- [ "--fingerprint" ], Getopt.String ("AAAA..", add_fingerprint),
+ [ L"fingerprint" ], Getopt.String ("AAAA..", add_fingerprint),
s_"Fingerprint of valid signing
key";
- [ "--format" ], Getopt.Set_string ("raw|qcow2", format),
s_"Output format (default: raw)";
- [ "--get-kernel" ], Getopt.Unit get_kernel_mode,
+ [ L"format" ], Getopt.Set_string ("raw|qcow2", format),
s_"Output format (default: raw)";
+ [ L"get-kernel" ], Getopt.Unit get_kernel_mode,
s_"Get kernel from image";
- [ "--gpg" ], Getopt.Set_string ("gpg", gpg),
s_"Set GPG binary/command";
- [ "-l"; "--list" ], Getopt.Unit list_mode,
s_"List available templates";
- [ "--long" ], Getopt.Unit list_set_long, s_"Shortcut for
--list-format long";
- [ "--list-format" ], Getopt.String ("short|long|json",
list_set_format),
+ [ L"gpg" ], Getopt.Set_string ("gpg", gpg),
s_"Set GPG binary/command";
+ [ S 'l'; L"list" ], Getopt.Unit list_mode,
s_"List available templates";
+ [ L"long" ], Getopt.Unit list_set_long, s_"Shortcut for
--list-format long";
+ [ L"list-format" ], Getopt.String ("short|long|json",
list_set_format),
s_"Set the format for --list (default:
short)";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
- [ "-m"; "--memsize" ], Getopt.Int ("mb",
set_memsize), s_"Set memory size";
- [ "--network" ], Getopt.Set network, s_"Enable appliance
network (default)";
- [ "--no-network" ], Getopt.Clear network, s_"Disable appliance
network";
- [ "--notes" ], Getopt.Unit notes_mode, s_"Display installation
notes";
- [ "-o"; "--output" ], Getopt.Set_string ("file",
output), s_"Set output filename";
- [ "--print-cache" ], Getopt.Unit print_cache_mode,
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ S 'm'; L"memsize" ], Getopt.Int ("mb",
set_memsize), s_"Set memory size";
+ [ L"network" ], Getopt.Set network, s_"Enable appliance
network (default)";
+ [ L"no-network" ], Getopt.Clear network, s_"Disable appliance
network";
+ [ L"notes" ], Getopt.Unit notes_mode, s_"Display installation
notes";
+ [ S 'o'; L"output" ], Getopt.Set_string ("file",
output), s_"Set output filename";
+ [ L"print-cache" ], Getopt.Unit print_cache_mode,
s_"Print info about template
cache";
- [ "--size" ], Getopt.String ("size", set_size),
s_"Set output disk size";
- [ "--smp" ], Getopt.Int ("vcpus", set_smp),
s_"Set number of vCPUs";
- [ "--source" ], Getopt.String ("URL", add_source),
s_"Set source URL";
- [ "--no-sync" ], Getopt.Clear sync, s_"Do not fsync output
file on exit";
- [ "--no-warn-if-partition" ], Getopt.Clear warn_if_partition,
+ [ L"size" ], Getopt.String ("size", set_size),
s_"Set output disk size";
+ [ L"smp" ], Getopt.Int ("vcpus", set_smp),
s_"Set number of vCPUs";
+ [ L"source" ], Getopt.String ("URL", add_source),
s_"Set source URL";
+ [ L"no-sync" ], Getopt.Clear sync, s_"Do not fsync output
file on exit";
+ [ L"no-warn-if-partition" ], Getopt.Clear warn_if_partition,
s_"Do not warn if writing to a
partition";
] in
let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 0ec1616..acba9b4 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -20,6 +20,7 @@
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Utils
@@ -151,44 +152,44 @@ read the man page virt-dib(1).
prepend (List.rev (String.nsplit "," arg)) extra_packages in
let argspec = [
- [ "-p"; "--element-path" ], Getopt.String
("path", append_element_path), s_"Add new a elements location";
- [ "--exclude-element" ], Getopt.String ("element",
append_excluded_element),
+ [ S 'p'; L"element-path" ], Getopt.String
("path", append_element_path), s_"Add new a elements location";
+ [ L"exclude-element" ], Getopt.String ("element",
append_excluded_element),
s_"Exclude the specified element";
- [ "--exclude-script" ], Getopt.String ("script",
append_excluded_script),
+ [ L"exclude-script" ], Getopt.String ("script",
append_excluded_script),
s_"Exclude the specified script";
- [ "--envvar" ], Getopt.String ("envvar[=value]",
append_envvar), s_"Carry/set this environment variable";
- [ "--skip-base" ], Getopt.Clear use_base, s_"Skip the
inclusion of the 'base' element";
- [ "--root-label" ], Getopt.String ("label", set_root_label),
s_"Label for the root fs";
- [ "--install-type" ], Getopt.Set_string ("type", install_type),
s_"Installation type";
- [ "--image-cache" ], Getopt.String ("directory",
set_image_cache), s_"Location for cached images";
- [ "-u" ], Getopt.Clear compressed, "Do not compress the
qcow2 image";
- [ "--qemu-img-options" ], Getopt.String ("option",
set_qemu_img_options),
+ [ L"envvar" ], Getopt.String ("envvar[=value]",
append_envvar), s_"Carry/set this environment variable";
+ [ L"skip-base" ], Getopt.Clear use_base, s_"Skip the inclusion
of the 'base' element";
+ [ L"root-label" ], Getopt.String ("label", set_root_label),
s_"Label for the root fs";
+ [ L"install-type" ], Getopt.Set_string ("type", install_type),
s_"Installation type";
+ [ L"image-cache" ], Getopt.String ("directory", set_image_cache),
s_"Location for cached images";
+ [ S 'u' ], Getopt.Clear compressed, "Do not compress the
qcow2 image";
+ [ L"qemu-img-options" ], Getopt.String ("option",
set_qemu_img_options),
s_"Add qemu-img options";
- [ "--mkfs-options" ], Getopt.String ("option",
set_mkfs_options),
+ [ L"mkfs-options" ], Getopt.String ("option", set_mkfs_options),
s_"Add mkfs options";
- [ "--extra-packages" ], Getopt.String ("pkg,...",
append_extra_packages),
+ [ L"extra-packages" ], Getopt.String ("pkg,...",
append_extra_packages),
s_"Add extra packages to install";
- [ "--ramdisk" ], Getopt.Set is_ramdisk, "Switch to a ramdisk
build";
- [ "--ramdisk-element" ], Getopt.Set_string ("name",
ramdisk_element), s_"Main element for building ramdisks";
+ [ L"ramdisk" ], Getopt.Set is_ramdisk, "Switch to a ramdisk
build";
+ [ L"ramdisk-element" ], Getopt.Set_string ("name",
ramdisk_element), s_"Main element for building ramdisks";
- [ "--name" ], Getopt.Set_string ("name", image_name),
s_"Name of the image";
- [ "--fs-type" ], Getopt.Set_string ("fs", fs_type),
s_"Filesystem for the image";
- [ "--size" ], Getopt.String ("size", set_size),
s_"Set output disk size";
- [ "--formats" ], Getopt.String ("qcow2,tgz,...", set_format),
s_"Output formats";
- [ "--arch" ], Getopt.Set_string ("arch", arch),
s_"Output architecture";
- [ "--drive" ], Getopt.String ("path", set_drive),
s_"Optional drive for caches";
+ [ L"name" ], Getopt.Set_string ("name", image_name),
s_"Name of the image";
+ [ L"fs-type" ], Getopt.Set_string ("fs", fs_type),
s_"Filesystem for the image";
+ [ L"size" ], Getopt.String ("size", set_size),
s_"Set output disk size";
+ [ L"formats" ], Getopt.String ("qcow2,tgz,...", set_format),
s_"Output formats";
+ [ L"arch" ], Getopt.Set_string ("arch", arch),
s_"Output architecture";
+ [ L"drive" ], Getopt.String ("path", set_drive),
s_"Optional drive for caches";
- [ "-m"; "--memsize" ], Getopt.Int ("mb",
set_memsize), s_"Set memory size";
- [ "--network" ], Getopt.Set network, s_"Enable appliance
network (default)";
- [ "--no-network" ], Getopt.Clear network, s_"Disable appliance
network";
- [ "--smp" ], Getopt.Int ("vcpus", set_smp),
s_"Set number of vCPUs";
- [ "--no-delete-on-failure" ], Getopt.Clear delete_on_failure,
+ [ S 'm'; L"memsize" ], Getopt.Int ("mb",
set_memsize), s_"Set memory size";
+ [ L"network" ], Getopt.Set network, s_"Enable appliance
network (default)";
+ [ L"no-network" ], Getopt.Clear network, s_"Disable appliance
network";
+ [ L"smp" ], Getopt.Int ("vcpus", set_smp),
s_"Set number of vCPUs";
+ [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure,
s_"Don't delete output file on
failure";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
- [ "--debug" ], Getopt.Int ("level", set_debug),
s_"Set debug level";
- [ "-B" ], Getopt.Set_string ("path", basepath),
s_"Base path of diskimage-builder library";
+ [ L"debug" ], Getopt.Int ("level", set_debug),
s_"Set debug level";
+ [ S 'B' ], Getopt.Set_string ("path", basepath),
s_"Base path of diskimage-builder library";
] in
let opthandle = create_standard_options argspec ~anon_fun:append_element usage_msg in
diff --git a/generator/customize.ml b/generator/customize.ml
index 0924732..259cd26 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -590,6 +590,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Getopt.OptionName
open Customize_utils
@@ -652,7 +653,7 @@ let rec argspec () =
| { op_type = Unit; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.Unit (fun () -> push_front %s ops),\n" discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -660,7 +661,7 @@ let rec argspec () =
| { op_type = String v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (s_\"%s\", fun s -> push_front (%s s)
ops),\n" v discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -668,7 +669,7 @@ let rec argspec () =
| { op_type = StringPair v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -681,7 +682,7 @@ let rec argspec () =
| { op_type = StringList v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -694,7 +695,7 @@ let rec argspec () =
| { op_type = TargetLinks v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -707,7 +708,7 @@ let rec argspec () =
| { op_type = PasswordSelector v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -720,7 +721,7 @@ let rec argspec () =
| { op_type = UserPasswordSelector v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -734,7 +735,7 @@ let rec argspec () =
| { op_type = SSHKeySelector v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -748,7 +749,7 @@ let rec argspec () =
| { op_type = StringFn (v, fn); op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -761,7 +762,7 @@ let rec argspec () =
| { op_type = SMPoolSelector v; op_name = name; op_discrim = discrim;
op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -778,7 +779,7 @@ let rec argspec () =
| { flag_type = FlagBool default; flag_ml_var = var; flag_name = name;
flag_shortdesc = shortdesc; flag_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
if default (* is true *) then
pr " Getopt.Clear %s,\n" var
else
@@ -790,7 +791,7 @@ let rec argspec () =
flag_name = name; flag_shortdesc = shortdesc;
flag_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -803,7 +804,7 @@ let rec argspec () =
flag_name = name; flag_shortdesc = shortdesc;
flag_pod_longdesc = longdesc } ->
pr " (\n";
- pr " [ \"--%s\" ],\n" name;
+ pr " [ L\"%s\" ],\n" name;
pr " Getopt.String (\n";
pr " s_\"%s\",\n" v;
pr " fun s ->\n";
@@ -855,7 +856,7 @@ pr " ] in
try
let ((_, spec, _), _, _) = List.find (
fun ((keys, _, _), _, _) ->
- List.mem (\"--\" ^ cmd) keys
+ List.mem (L cmd) keys
) argspec in
(match spec with
| Getopt.Unit fn -> fn ()
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index b841c5f..f83a940 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -18,6 +18,7 @@
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
module G = Guestfs
@@ -51,15 +52,15 @@ let parse_cmdline () =
prefix := Some p in
let argspec = [
- [ "-a"; "--add" ], Getopt.String (s_"file",
set_file), s_"Add disk image file";
- [ "-c"; "--connect" ], Getopt.Set_string
(s_"uri", libvirturi), s_"Set libvirt URI";
- [ "-d"; "--domain" ], Getopt.String (s_"domain",
set_domain), s_"Set libvirt guest name";
- [ "--format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
- [ "-o"; "--output" ], Getopt.Set_string
(s_"directory", output), s_"Output directory";
- [ "--unversioned-names" ], Getopt.Set unversioned,
+ [ S 'a'; L"add" ], Getopt.String (s_"file",
set_file), s_"Add disk image file";
+ [ S 'c'; L"connect" ], Getopt.Set_string (s_"uri",
libvirturi), s_"Set libvirt URI";
+ [ S 'd'; L"domain" ], Getopt.String (s_"domain",
set_domain), s_"Set libvirt guest name";
+ [ L"format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ S 'o'; L"output" ], Getopt.Set_string
(s_"directory", output), s_"Output directory";
+ [ L"unversioned-names" ], Getopt.Set unversioned,
s_"Use unversioned names for
files";
- [ "--prefix" ], Getopt.String (s_"prefix", set_prefix),
s_"Prefix for files";
+ [ L"prefix" ], Getopt.String (s_"prefix", set_prefix),
s_"Prefix for files";
] in
let usage_msg =
sprintf (f_"\
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 3bbfa46..e7ee84a 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -19,6 +19,7 @@
open Printf
open Common_gettext.Gettext
+open Getopt.OptionName
module Char = struct
include Char
@@ -571,13 +572,13 @@ let create_standard_options argspec ?anon_fun usage_msg =
let set_debug_gc () =
at_exit (fun () -> Gc.compact()) in
let argspec = [
- [ "-V"; "--version" ], Getopt.Unit print_version_and_exit,
s_"Display version and exit";
- [ "-v"; "--verbose" ], Getopt.Unit set_verbose, s_"Enable
libguestfs debugging messages";
- [ "-x" ], Getopt.Unit set_trace, s_"Enable tracing of
libguestfs calls";
- [ "--debug-gc" ], Getopt.Unit set_debug_gc,
Getopt.hidden_option_description;
- [ "-q"; "--quiet" ], Getopt.Unit set_quiet,
s_"Don't print progress messages";
- [ "--color"; "--colors";
- "--colour"; "--colours" ], Getopt.Unit set_colours, s_"Use
ANSI colour sequences even if not tty";
+ [ 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";
+ [ S 'x' ], Getopt.Unit set_trace, s_"Enable tracing of
libguestfs calls";
+ [ L"debug-gc" ], Getopt.Unit set_debug_gc,
Getopt.hidden_option_description;
+ [ S 'q'; L"quiet" ], Getopt.Unit set_quiet, s_"Don't
print progress messages";
+ [ L"color"; L"colors";
+ L"colour"; L"colours" ], Getopt.Unit set_colours, s_"Use
ANSI colour sequences even if not tty";
] @ argspec in
Getopt.create argspec ?anon_fun usage_msg
diff --git a/mllib/getopt.ml b/mllib/getopt.ml
index 550baa4..3bfcd21 100644
--- a/mllib/getopt.ml
+++ b/mllib/getopt.ml
@@ -29,7 +29,12 @@ type spec =
| Int of string * (int -> unit)
| Set_int of string * int ref
-type keys = string list
+module OptionName = struct
+ type option_name = S of char | L of string
+end
+open OptionName
+
+type keys = option_name list
type doc = string
type usage_msg = string
type anon_fun = (string -> unit)
@@ -49,6 +54,14 @@ external getopt_parse : string array -> (c_keys * spec * doc) array
-> ?anon_fun
let column_wrap = 38
+let string_of_option_name = function
+ | S c -> sprintf "-%c" c
+ | L s -> "--" ^ s
+
+let string_of_option_name_no_dashes = function
+ | S c -> String.make 1 c
+ | L s -> s
+
let show_help h () =
let b = Buffer.create 1024 in
@@ -58,10 +71,11 @@ let show_help h () =
let prologue = sprintf (f_"%s\nOptions:\n") h.usage_msg in
Buffer.add_string b prologue;
- let specs = List.filter (
- fun (_, _, doc) ->
+ let specs =
+ List.filter (
+ fun (_, _, doc) ->
doc <> hidden_option_description
- ) h.specs in
+ ) h.specs in
List.iter (
fun (keys, spec, doc) ->
@@ -72,7 +86,7 @@ let show_help h () =
in
add " ";
- add (String.concat ", " keys);
+ add (String.concat ", " (List.map string_of_option_name keys));
let arg =
match spec with
| Unit _
@@ -109,9 +123,9 @@ let display_short_options h () =
List.iter (
fun (args, _, _) ->
List.iter (
- fun arg ->
- if is_prefix arg "-" && not (is_prefix arg "--")
then
- printf "%s\n" arg
+ function
+ | S _ as arg -> print_endline (string_of_option_name arg)
+ | L _ -> ()
) args
) h.specs;
exit 0
@@ -119,73 +133,44 @@ let display_long_options h () =
List.iter (
fun (args, _, _) ->
List.iter (
- fun arg ->
- if is_prefix arg "--" && arg <>
"--long-options" &&
- arg <> "--short-options" then
- printf "%s\n" arg
+ function
+ | L "short-options" | L "long-options"
+ | S _ -> ()
+ | L _ as arg -> print_endline (string_of_option_name arg)
) args
) h.specs;
exit 0
-(* Skip any leading '-' characters when comparing command line args. *)
-let skip_dashes str =
- let n = String.length str in
- let rec loop i =
- if i >= n then invalid_arg "skip_dashes"
- else if String.unsafe_get str i = '-' then loop (i+1)
- else i
- in
- let i = loop 0 in
- if i = 0 then str
- else String.sub str i (n-i)
-
let compare_command_line_args a b =
- compare (String.lowercase (skip_dashes a)) (String.lowercase (skip_dashes b))
+ let a = String.lowercase (string_of_option_name_no_dashes a) in
+ let b = String.lowercase (string_of_option_name_no_dashes b) in
+ compare a b
let create specs ?anon_fun usage_msg =
(* Sanity check the input *)
- let validate_key key =
- if String.length key == 0 || key == "-" || key == "--"
- || key.[0] != '-' then
- invalid_arg (sprintf "invalid option key: '%s'" key)
+ let validate_key = function
+ | L"" -> invalid_arg "Getopt spec: invalid empty long option"
+ | L"help" -> invalid_arg "Getopt spec: should not have
L\"help\""
+ | L"short-options" ->
+ invalid_arg "Getopt spec: should not have L\"short-options\""
+ | L"long-options" ->
+ invalid_arg "Getopt spec: should not have L\"long-options\""
+ | L s when s.[0] = '-' ->
+ invalid_arg (sprintf "Getopt spec: L%S should not begin with a dash"
+ s)
+ | L s when String.contains s '_' ->
+ invalid_arg (sprintf "Getopt spec: L%S should not contain '_'"
+ s)
+ | _ -> ()
in
-
List.iter (
fun (keys, spec, doc) ->
if keys == [] then
invalid_arg "empty keys for Getopt spec";
- List.iter validate_key keys;
+ List.iter validate_key keys
) specs;
- let t =
- {
- specs = []; (* Set it later, with own options, and sorted. *)
- anon_fun = anon_fun;
- usage_msg = usage_msg;
- } in
-
- let specs = specs @ [
- [ "--short-options" ], Unit (display_short_options t),
hidden_option_description;
- [ "--long-options" ], Unit (display_long_options t),
hidden_option_description;
- ] in
-
- (* Decide whether the help option can be added, and which switches use. *)
- let has_dash_help = ref false in
- let has_dash_dash_help = ref false in
- List.iter (
- fun (keys, _, _) ->
- if not (!has_dash_help) then
- has_dash_help := List.mem "-help" keys;
- if not (!has_dash_dash_help) then
- has_dash_dash_help := List.mem "--help" keys;
- ) specs;
- let help_keys = [] @
- (if !has_dash_help then [] else [ "-help" ]) @
- (if !has_dash_dash_help then [] else [ "--help" ]) in
- let specs = specs @
- (if help_keys <> [] then [ help_keys, Unit (show_help t), s_"Display brief
help"; ] else []) in
-
- (* Sort the specs, and set them in the handle. *)
+ (* Sort the specs. *)
let specs = List.map (
fun (keys, action, doc) ->
List.hd (List.sort compare_command_line_args keys), (keys, action, doc)
@@ -194,14 +179,26 @@ let create specs ?anon_fun usage_msg =
let cmp (arg1, _) (arg2, _) = compare_command_line_args arg1 arg2 in
List.sort cmp specs in
let specs = List.map snd specs in
- t.specs <- specs;
+ let t = {
+ specs = specs;
+ anon_fun = anon_fun;
+ usage_msg = usage_msg;
+ } in
+ let added_options = [
+ [ L"short-options" ], Unit (display_short_options t),
+ hidden_option_description;
+ [ L"long-options" ], Unit (display_long_options t),
+ hidden_option_description;
+ [ L"help" ], Unit (show_help t), s_"Display brief help";
+ ] in
+ t.specs <- added_options @ specs;
t
let parse_argv t argv =
let specs = List.map (
fun (keys, spec, doc) ->
- Array.of_list keys, spec, doc
+ Array.of_list (List.map string_of_option_name keys), spec, doc
) t.specs in
let specs = Array.of_list specs in
getopt_parse argv specs ?anon_fun:t.anon_fun t.usage_msg
diff --git a/mllib/getopt.mli b/mllib/getopt.mli
index 2a8bada..a5951f7 100644
--- a/mllib/getopt.mli
+++ b/mllib/getopt.mli
@@ -18,29 +18,34 @@
type spec =
| Unit of (unit -> unit)
- (* Simple option with no argument; call the function. *)
+ (** Simple option with no argument; call the function. *)
| Set of bool ref
- (* Simple option with no argument; set the reference to true. *)
+ (** Simple option with no argument; set the reference to true. *)
| Clear of bool ref
- (* Simple option with no argument; set the reference to false. *)
+ (** Simple option with no argument; set the reference to false. *)
| String of string * (string -> unit)
- (* Option requiring an argument; the first element in the tuple
- is the documentation string of the argument, and the second
- is the function to call. *)
+ (** Option requiring an argument; the first element in the tuple
+ is the documentation string of the argument, and the second
+ is the function to call. *)
| Set_string of string * string ref
- (* Option requiring an argument; the first element in the tuple
- is the documentation string of the argument, and the second
- is the reference to be set. *)
+ (** Option requiring an argument; the first element in the tuple
+ is the documentation string of the argument, and the second
+ is the reference to be set. *)
| Int of string * (int -> unit)
- (* Option requiring an integer value as argument; the first
- element in the tuple is the documentation string of the
- argument, and the second is the function to call. *)
+ (** Option requiring an integer value as argument; the first
+ element in the tuple is the documentation string of the
+ argument, and the second is the function to call. *)
| Set_int of string * int ref
- (* Option requiring an integer value as argument; the first
- element in the tuple is the documentation string of the
- argument, and the second is the reference to be set. *)
+ (** Option requiring an integer value as argument; the first
+ element in the tuple is the documentation string of the
+ argument, and the second is the reference to be set. *)
-type keys = string list
+module OptionName : sig
+ type option_name =
+ | S of char (** short option like -a *)
+ | L of string (** long option like --add *)
+end
+type keys = OptionName.option_name list
type doc = string
type usage_msg = string
type anon_fun = (string -> unit)
@@ -49,9 +54,13 @@ type speclist = (keys * spec * doc) list
val hidden_option_description : string
-val compare_command_line_args : string -> string -> int
+val compare_command_line_args : OptionName.option_name -> OptionName.option_name ->
int
(** Compare command line arguments for equality, ignoring any leading [-]s. *)
+val string_of_option_name : OptionName.option_name -> string
+(** Convert an {!OptionName.option_name} to a string. For instance
+ [L"foo"] is converted to ["--foo"]. *)
+
type t
(** The abstract data type. *)
diff --git a/resize/resize.ml b/resize/resize.ml
index 185f5a0..7d06f18 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -20,6 +20,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Getopt.OptionName
module G = Guestfs
@@ -183,26 +184,26 @@ let main () =
let unknown_fs_mode = ref "warn" in
let argspec = [
- [ "--align-first" ], Getopt.Set_string (s_"never|always|auto",
align_first), s_"Align first partition (default: auto)";
- [ "--alignment" ], Getopt.Set_int (s_"sectors", alignment),
s_"Set partition alignment (default: 128 sectors)";
- [ "--no-copy-boot-loader" ], Getopt.Clear copy_boot_loader,
s_"Don't copy boot loader";
- [ "-d"; "--debug" ], Getopt.Unit set_verbose,
s_"Enable debugging messages";
- [ "--delete" ], Getopt.String (s_"part", add deletes),
s_"Delete partition";
- [ "--expand" ], Getopt.String (s_"part", set_expand),
s_"Expand partition";
- [ "--no-expand-content" ], Getopt.Clear expand_content, s_"Don't
expand content";
- [ "--no-extra-partition" ], Getopt.Clear extra_partition,
s_"Don't create extra partition";
- [ "--format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
- [ "--ignore" ], Getopt.String (s_"part", add ignores),
s_"Ignore partition";
- [ "--lv-expand"; "--LV-expand"; "--lvexpand";
"--LVexpand" ], Getopt.String (s_"lv", add lv_expands), s_"Expand
logical volume";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make
output machine readable";
- [ "-n"; "--dry-run"; "--dryrun" ], Getopt.Set
dryrun, s_"Don't perform changes";
- [ "--ntfsresize-force" ], Getopt.Set ntfsresize_force, s_"Force
ntfsresize";
- [ "--output-format" ], Getopt.Set_string (s_"format",
output_format), s_"Format of output disk";
- [ "--resize" ], Getopt.String (s_"part=size", add resizes),
s_"Resize partition";
- [ "--resize-force" ], Getopt.String (s_"part=size", add
resizes_force), s_"Forcefully resize partition";
- [ "--shrink" ], Getopt.String (s_"part", set_shrink),
s_"Shrink partition";
- [ "--no-sparse" ], Getopt.Clear sparse, s_"Turn off sparse
copying";
- [ "--unknown-filesystems" ], Getopt.Set_string
(s_"ignore|warn|error", unknown_fs_mode),
+ [ L"align-first" ], Getopt.Set_string (s_"never|always|auto",
align_first), s_"Align first partition (default: auto)";
+ [ L"alignment" ], Getopt.Set_int (s_"sectors", alignment),
s_"Set partition alignment (default: 128 sectors)";
+ [ L"no-copy-boot-loader" ], Getopt.Clear copy_boot_loader,
s_"Don't copy boot loader";
+ [ S 'd'; L"debug" ], Getopt.Unit set_verbose,
s_"Enable debugging messages";
+ [ L"delete" ], Getopt.String (s_"part", add deletes),
s_"Delete partition";
+ [ L"expand" ], Getopt.String (s_"part", set_expand),
s_"Expand partition";
+ [ L"no-expand-content" ], Getopt.Clear expand_content, s_"Don't
expand content";
+ [ L"no-extra-partition" ], Getopt.Clear extra_partition,
s_"Don't create extra partition";
+ [ L"format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
+ [ L"ignore" ], Getopt.String (s_"part", add ignores),
s_"Ignore partition";
+ [ L"lv-expand"; L"LV-expand"; L"lvexpand";
L"LVexpand" ], Getopt.String (s_"lv", add lv_expands), s_"Expand
logical volume";
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ S 'n'; L"dry-run"; L"dryrun" ], Getopt.Set
dryrun, s_"Don't perform changes";
+ [ L"ntfsresize-force" ], Getopt.Set ntfsresize_force, s_"Force
ntfsresize";
+ [ L"output-format" ], Getopt.Set_string (s_"format",
output_format), s_"Format of output disk";
+ [ L"resize" ], Getopt.String (s_"part=size", add resizes),
s_"Resize partition";
+ [ L"resize-force" ], Getopt.String (s_"part=size", add
resizes_force), s_"Forcefully resize partition";
+ [ L"shrink" ], Getopt.String (s_"part", set_shrink),
s_"Shrink partition";
+ [ L"no-sparse" ], Getopt.Clear sparse, s_"Turn off sparse
copying";
+ [ L"unknown-filesystems" ], Getopt.Set_string
(s_"ignore|warn|error", unknown_fs_mode),
s_"Behaviour on expand unknown
filesystems (default: warn)";
] in
let disks = ref [] in
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 3593e26..3eb0d5b 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -22,6 +22,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Utils
@@ -64,16 +65,16 @@ let parse_cmdline () =
let zeroes = ref [] in
let argspec = [
- [ "--check-tmpdir" ], Getopt.String ("ignore|...",
set_check_tmpdir), s_"Check there is enough space in $TMPDIR";
- [ "--compress" ], Getopt.Set compress, s_"Compressed output
format";
- [ "--convert" ], Getopt.Set_string (s_"format", convert),
s_"Format of output disk (default: same as input)";
- [ "--format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
- [ "--ignore" ], Getopt.String (s_"fs", add ignores),
s_"Ignore filesystem";
- [ "--in-place"; "--inplace" ], Getopt.Set in_place,
s_"Modify the disk image in-place";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
- [ "-o" ], Getopt.Set_string (s_"option", option),
s_"Add qemu-img options";
- [ "--tmp" ], Getopt.Set_string (s_"block|dir|prebuilt:file",
tmp), s_"Set temporary block device, directory or prebuilt file";
- [ "--zero" ], Getopt.String (s_"fs", add zeroes),
s_"Zero filesystem";
+ [ L"check-tmpdir" ], Getopt.String ("ignore|...",
set_check_tmpdir), s_"Check there is enough space in $TMPDIR";
+ [ L"compress" ], Getopt.Set compress, s_"Compressed output
format";
+ [ L"convert" ], Getopt.Set_string (s_"format", convert),
s_"Format of output disk (default: same as input)";
+ [ L"format" ], Getopt.Set_string (s_"format", format),
s_"Format of input disk";
+ [ L"ignore" ], Getopt.String (s_"fs", add ignores),
s_"Ignore filesystem";
+ [ L"in-place"; L"inplace" ], Getopt.Set in_place,
s_"Modify the disk image in-place";
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ S 'o' ], Getopt.Set_string (s_"option", option),
s_"Add qemu-img options";
+ [ L"tmp" ], Getopt.Set_string (s_"block|dir|prebuilt:file",
tmp), s_"Set temporary block device, directory or prebuilt file";
+ [ L"zero" ], Getopt.String (s_"fs", add zeroes),
s_"Zero filesystem";
] in
let disks = ref [] in
let anon_fun s = push_front s disks in
diff --git a/sysprep/main.ml b/sysprep/main.ml
index b2df880..01ea590 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -21,6 +21,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Getopt.OptionName
open Sysprep_operation
@@ -117,21 +118,21 @@ let main () =
in
let basic_args = [
- [ "-a"; "--add" ], Getopt.String (s_"file",
add_file), s_"Add disk image file";
- [ "-c"; "--connect" ], Getopt.Set_string
(s_"uri", libvirturi), s_"Set libvirt URI";
- [ "-d"; "--domain" ], Getopt.String
(s_"domain", set_domain), s_"Set libvirt guest name";
- [ "-n"; "--dryrun"; "--dry-run" ], Getopt.Set
dryrun, s_"Perform a dry run";
- [ "--dump-pod" ], Getopt.Unit dump_pod,
Getopt.hidden_option_description;
- [ "--dump-pod-options" ], Getopt.Unit dump_pod_options,
Getopt.hidden_option_description;
- [ "--enable" ], Getopt.String (s_"operations", set_enable),
s_"Enable specific operations";
- [ "--format" ], Getopt.String (s_"format", set_format),
s_"Set format (default: auto)";
- [ "--list-operations" ], Getopt.Unit list_operations, s_"List
supported operations";
- [ "--mount-options" ], Getopt.Set_string (s_"opts",
mount_opts), s_"Set mount options (eg /:noatime;/var:rw,noatime)";
- [ "--network" ], Getopt.Set network, s_"Enable appliance
network";
- [ "--no-network" ], Getopt.Clear network, s_"Disable appliance
network (default)";
- [ "--no-selinux-relabel" ], Getopt.Unit (fun () -> ()),
+ [ S 'a'; L"add" ], Getopt.String (s_"file",
add_file), s_"Add disk image file";
+ [ S 'c'; L"connect" ], Getopt.Set_string
(s_"uri", libvirturi), s_"Set libvirt URI";
+ [ S 'd'; L"domain" ], Getopt.String (s_"domain",
set_domain), s_"Set libvirt guest name";
+ [ S 'n'; L"dryrun"; L"dry-run" ], Getopt.Set
dryrun, s_"Perform a dry run";
+ [ L"dump-pod" ], Getopt.Unit dump_pod,
Getopt.hidden_option_description;
+ [ L"dump-pod-options" ], Getopt.Unit dump_pod_options,
Getopt.hidden_option_description;
+ [ L"enable" ], Getopt.String (s_"operations", set_enable),
s_"Enable specific operations";
+ [ L"format" ], Getopt.String (s_"format", set_format),
s_"Set format (default: auto)";
+ [ L"list-operations" ], Getopt.Unit list_operations, s_"List
supported operations";
+ [ L"mount-options" ], Getopt.Set_string (s_"opts", mount_opts),
s_"Set mount options (eg /:noatime;/var:rw,noatime)";
+ [ L"network" ], Getopt.Set network, s_"Enable appliance
network";
+ [ L"no-network" ], Getopt.Clear network, s_"Disable appliance
network (default)";
+ [ L"no-selinux-relabel" ], Getopt.Unit (fun () -> ()),
s_"Compatibility option, does
nothing";
- [ "--operation"; "--operations" ], Getopt.String
(s_"operations", set_operations), s_"Enable/disable specific
operations";
+ [ L"operation"; L"operations" ], Getopt.String
(s_"operations", set_operations), s_"Enable/disable specific
operations";
] in
let args = basic_args @ Sysprep_operation.extra_args () in
let usage_msg =
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index b4d650f..4ccd03c 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -21,6 +21,7 @@ open Common_utils
open Printf
open Common_gettext.Gettext
+open Getopt.OptionName
class filesystem_side_effects =
object
@@ -215,7 +216,8 @@ let dump_pod_options () =
extra_pod_description = pod }) ->
List.map (
fun arg_name ->
- let heading = sprintf "B<%s>" arg_name in
+ let heading =
+ sprintf "B<%s>" (Getopt.string_of_option_name arg_name) in
arg_name, (op_name, heading, pod)
) arg_names
@@ -228,7 +230,9 @@ let dump_pod_options () =
extra_pod_description = pod }) ->
List.map (
fun arg_name ->
- let heading = sprintf "B<%s> %s" arg_name arg_val in
+ let heading =
+ sprintf "B<%s> %s"
+ (Getopt.string_of_option_name arg_name) arg_val in
arg_name, (op_name, heading, pod)
) arg_names
diff --git a/sysprep/sysprep_operation_script.ml b/sysprep/sysprep_operation_script.ml
index cc0ec9b..ff4b073 100644
--- a/sysprep/sysprep_operation_script.ml
+++ b/sysprep/sysprep_operation_script.ml
@@ -21,6 +21,7 @@ open Unix
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Sysprep_operation
@@ -129,7 +130,7 @@ B<Note:> This is different from I<--firstboot> scripts
(which run
in the context of the guest when it is booting first time).
I<--script> scripts run on the host, not in the guest.");
extra_args = [
- { extra_argspec = [ "--scriptdir" ], Getopt.String (s_"dir",
set_scriptdir), s_"Mount point on host";
+ { extra_argspec = [ L"scriptdir" ], Getopt.String (s_"dir",
set_scriptdir), s_"Mount point on host";
extra_pod_argval = Some "SCRIPTDIR";
extra_pod_description = s_"\
The mount point (an empty directory on the host) used when
@@ -142,7 +143,7 @@ If I<--scriptdir> is not specified then a temporary mountpoint
will be created."
};
- { extra_argspec = [ "--script" ], Getopt.String (s_"script",
add_script), s_"Script or program to run on guest";
+ { extra_argspec = [ L"script" ], Getopt.String (s_"script",
add_script), s_"Script or program to run on guest";
extra_pod_argval = Some "SCRIPT";
extra_pod_description = s_"\
Run the named C<SCRIPT> (a shell script or program) against the
diff --git a/sysprep/sysprep_operation_user_account.ml
b/sysprep/sysprep_operation_user_account.ml
index cf7dc57..6f44b9d 100644
--- a/sysprep/sysprep_operation_user_account.ml
+++ b/sysprep/sysprep_operation_user_account.ml
@@ -21,6 +21,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Getopt.OptionName
open Sysprep_operation
@@ -109,7 +110,7 @@ The \"root\" account is not removed.
See the I<--remove-user-accounts> parameter for a way to specify
how to remove only some users, or to not remove some others.");
extra_args = [
- { extra_argspec = [ "--remove-user-accounts" ], Getopt.String
(s_"users", add_users remove_users), s_"Users to remove";
+ { extra_argspec = [ L"remove-user-accounts" ], Getopt.String
(s_"users", add_users remove_users), s_"Users to remove";
extra_pod_argval = Some "USERS";
extra_pod_description = s_"\
The user accounts to be removed from the guest.
@@ -124,7 +125,7 @@ would only remove the user accounts C<bob> and C<eve>.
This option can be specified multiple times."
};
- { extra_argspec = [ "--keep-user-accounts" ], Getopt.String
(s_"users", add_users keep_users), s_"Users to keep";
+ { extra_argspec = [ L"keep-user-accounts" ], Getopt.String
(s_"users", add_users keep_users), s_"Users to keep";
extra_pod_argval = Some "USERS";
extra_pod_description = s_"\
The user accounts to be kept in the guest.
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index e704bd4..cb8397f 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -22,6 +22,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Types
open Utils
@@ -165,45 +166,45 @@ let parse_cmdline () =
String.concat "|" (Modules_list.output_modules ()) in
let argspec = [
- [ "-b"; "--bridge" ], Getopt.String ("in:out",
add_bridge), s_"Map bridge 'in' to 'out'";
- [ "--compressed" ], Getopt.Set compressed, s_"Compress output
file";
- [ "--dcpath"; "--dcPath" ], Getopt.String ("path",
set_string_option_once "--dcpath" dcpath),
+ [ S 'b'; L"bridge" ], Getopt.String ("in:out",
add_bridge), s_"Map bridge 'in' to 'out'";
+ [ L"compressed" ], Getopt.Set compressed, s_"Compress output
file";
+ [ L"dcpath"; L"dcPath" ], Getopt.String ("path",
set_string_option_once "--dcpath" dcpath),
s_"Override dcPath (for vCenter)";
- [ "--debug-overlay"; "--debug-overlays" ], Getopt.Set
debug_overlays, s_"Save overlay files";
- [ "-i" ], Getopt.String (i_options, set_input_mode), s_"Set
input mode (default: libvirt)";
- [ "-ic" ], Getopt.String ("uri", set_string_option_once
"-ic" input_conn),
+ [ L"debug-overlay"; L"debug-overlays" ], Getopt.Set
debug_overlays, s_"Save overlay files";
+ [ S 'i' ], Getopt.String (i_options, set_input_mode), s_"Set
input mode (default: libvirt)";
+ [ L"ic" ], Getopt.String ("uri", set_string_option_once
"-ic" input_conn),
s_"Libvirt URI";
- [ "-if" ], Getopt.String ("format", set_string_option_once
"-if" input_format),
+ [ L"if" ], Getopt.String ("format", set_string_option_once
"-if" input_format),
s_"Input format (for -i disk)";
- [ "--in-place" ], Getopt.Set in_place, s_"Only tune the guest
in the input VM";
- [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
- [ "-n"; "--network" ], Getopt.String ("in:out",
add_network), s_"Map network 'in' to 'out'";
- [ "--no-copy" ], Getopt.Clear do_copy, s_"Just write the
metadata";
- [ "--no-trim" ], Getopt.String ("-", no_trim_warning),
+ [ L"in-place" ], Getopt.Set in_place, s_"Only tune the guest
in the input VM";
+ [ L"machine-readable" ], Getopt.Set machine_readable, s_"Make output
machine readable";
+ [ S 'n'; L"network" ], Getopt.String ("in:out",
add_network), s_"Map network 'in' to 'out'";
+ [ L"no-copy" ], Getopt.Clear do_copy, s_"Just write the
metadata";
+ [ L"no-trim" ], Getopt.String ("-", no_trim_warning),
s_"Ignored for backwards
compatibility";
- [ "-o" ], Getopt.String (o_options, set_output_mode), s_"Set
output mode (default: libvirt)";
- [ "-oa" ], Getopt.String ("sparse|preallocated",
set_output_alloc),
+ [ S 'o' ], Getopt.String (o_options, set_output_mode), s_"Set
output mode (default: libvirt)";
+ [ L"oa" ], Getopt.String ("sparse|preallocated",
set_output_alloc),
s_"Set output allocation mode";
- [ "-oc" ], Getopt.String ("uri", set_string_option_once
"-oc" output_conn),
+ [ L"oc" ], Getopt.String ("uri", set_string_option_once
"-oc" output_conn),
s_"Libvirt URI";
- [ "-of" ], Getopt.String ("raw|qcow2",
set_string_option_once "-of" output_format),
+ [ L"of" ], Getopt.String ("raw|qcow2",
set_string_option_once "-of" output_format),
s_"Set output format";
- [ "-on" ], Getopt.String ("name", set_string_option_once
"-on" output_name),
+ [ L"on" ], Getopt.String ("name", set_string_option_once
"-on" output_name),
s_"Rename guest when converting";
- [ "-os" ], Getopt.String ("storage", set_string_option_once
"-os" output_storage),
+ [ L"os" ], Getopt.String ("storage", set_string_option_once
"-os" output_storage),
s_"Set output storage location";
- [ "--password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
+ [ L"password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
s_"Use password from file";
- [ "--print-source" ], Getopt.Set print_source, s_"Print source and
stop";
- [ "--qemu-boot" ], Getopt.Set qemu_boot, s_"Boot in qemu (-o
qemu only)";
- [ "--root" ], Getopt.String ("ask|... ", set_root_choice),
s_"How to choose root filesystem";
- [ "--vdsm-image-uuid" ], Getopt.String ("uuid",
add_vdsm_image_uuid), s_"Output image UUID(s)";
- [ "--vdsm-vol-uuid" ], Getopt.String ("uuid", add_vdsm_vol_uuid),
s_"Output vol UUID(s)";
- [ "--vdsm-vm-uuid" ], Getopt.String ("uuid",
set_string_option_once "--vdsm-vm-uuid" vdsm_vm_uuid),
+ [ L"print-source" ], Getopt.Set print_source, s_"Print source and
stop";
+ [ L"qemu-boot" ], Getopt.Set qemu_boot, s_"Boot in qemu (-o qemu
only)";
+ [ L"root" ], Getopt.String ("ask|... ", set_root_choice),
s_"How to choose root filesystem";
+ [ L"vdsm-image-uuid" ], Getopt.String ("uuid",
add_vdsm_image_uuid), s_"Output image UUID(s)";
+ [ L"vdsm-vol-uuid" ], Getopt.String ("uuid", add_vdsm_vol_uuid),
s_"Output vol UUID(s)";
+ [ L"vdsm-vm-uuid" ], Getopt.String ("uuid",
set_string_option_once "--vdsm-vm-uuid" vdsm_vm_uuid),
s_"Output VM UUID";
- [ "--vdsm-ovf-output" ], Getopt.String ("-",
set_string_option_once "--vdsm-ovf-output" vdsm_ovf_output),
+ [ L"vdsm-ovf-output" ], Getopt.String ("-",
set_string_option_once "--vdsm-ovf-output" vdsm_ovf_output),
s_"Output OVF file";
- [ "--vmtype" ], Getopt.String ("-", vmtype_warning),
+ [ L"vmtype" ], Getopt.String ("-", vmtype_warning),
s_"Ignored for backwards
compatibility";
] in
let args = ref [] in
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index fe34413..ecfaf29 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -22,6 +22,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
+open Getopt.OptionName
open Utils
@@ -41,9 +42,9 @@ let rec main () =
(* Handle the command line. *)
let argspec = [
- [ "-ic" ], Getopt.String ("uri", set_string_option_once
"-ic" input_conn),
+ [ L"ic" ], Getopt.String ("uri", set_string_option_once
"-ic" input_conn),
s_"Libvirt URI";
- [ "--password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
+ [ L"password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
s_"Use password from file";
] in
let args = ref [] in
--
2.7.4
8:21 a.m.
New subject: [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.
On Monday, 18 July 2016 11:46:46 CEST Richard W.M. Jones wrote:
---
Note that this changes the way -foo options are handled: this basically
makes them as --foo, but still working as -foo because getopt_long_only
is used. IMHO either add a new M".." ([M]edium or [T]runcated or
[D]ash or ...), or turn S to get a string instead.
- let validate_key key =
- if String.length key == 0 || key == "-" || key == "--"
- || key.[0] != '-' then
- invalid_arg (sprintf "invalid option key: '%s'" key)
+ let validate_key = function
+ | L"" -> invalid_arg "Getopt spec: invalid empty long
option"
+ | L"help" -> invalid_arg "Getopt spec: should not have
L\"help\""
Theoretically both Arg and the current Getopt allow applications to
provide an own handler for --help, instead of the built-in one.
+ | L s when String.contains s '_' ->
+ invalid_arg (sprintf "Getopt spec: L%S should not contain '_'"
+ s)
Why this limitation?
- let t =
- {
- specs = []; (* Set it later, with own options, and sorted. *)
- anon_fun = anon_fun;
- usage_msg = usage_msg;
- } in
-
- let specs = specs @ [
- [ "--short-options" ], Unit (display_short_options t),
hidden_option_description;
- [ "--long-options" ], Unit (display_long_options t),
hidden_option_description;
- ] in
-
- (* Decide whether the help option can be added, and which switches use. *)
- let has_dash_help = ref false in
- let has_dash_dash_help = ref false in
- List.iter (
- fun (keys, _, _) ->
- if not (!has_dash_help) then
- has_dash_help := List.mem "-help" keys;
- if not (!has_dash_dash_help) then
- has_dash_dash_help := List.mem "--help" keys;
- ) specs;
- let help_keys = [] @
- (if !has_dash_help then [] else [ "-help" ]) @
- (if !has_dash_dash_help then [] else [ "--help" ]) in
- let specs = specs @
- (if help_keys <> [] then [ help_keys, Unit (show_help t), s_"Display
brief help"; ] else []) in
-
- (* Sort the specs, and set them in the handle. *)
+ (* Sort the specs. *)
let specs = List.map (
fun (keys, action, doc) ->
List.hd (List.sort compare_command_line_args keys), (keys, action, doc)
@@ -194,14 +179,26 @@ let create specs ?anon_fun usage_msg =
let cmp (arg1, _) (arg2, _) = compare_command_line_args arg1 arg2 in
List.sort cmp specs in
let specs = List.map snd specs in
- t.specs <- specs;
+ let t = {
+ specs = specs;
+ anon_fun = anon_fun;
+ usage_msg = usage_msg;
+ } in
+ let added_options = [
+ [ L"short-options" ], Unit (display_short_options t),
+ hidden_option_description;
+ [ L"long-options" ], Unit (display_long_options t),
+ hidden_option_description;
+ [ L"help" ], Unit (show_help t), s_"Display brief help";
+ ] in
+ t.specs <- added_options @ specs;
IMHO it'd be better to sort the specs at this point, like done before;
otherwise, --help (and potentially any non-hidden built-in option added
here) will be shown only at the end of the other specs.
Thanks,
--
Pino Toscano
8:43 a.m.
New subject: [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.
On Mon, Jul 18, 2016 at 03:21:31PM +0200, Pino Toscano wrote:
On Monday, 18 July 2016 11:46:46 CEST Richard W.M. Jones wrote:
> ---
Note that this changes the way -foo options are handled: this basically
makes them as --foo, but still working as -foo because getopt_long_only
is used. IMHO either add a new M".." ([M]edium or [T]runcated or
[D]ash or ...), or turn S to get a string instead.
Do you mean only for the 'virt-v2v --help' output? I don't think
there is any other place in the code where the M option would be
handled differently from the L option.
> - let validate_key key =
> - if String.length key == 0 || key == "-" || key == "--"
> - || key.[0] != '-' then
> - invalid_arg (sprintf "invalid option key: '%s'" key)
> + let validate_key = function
> + | L"" -> invalid_arg "Getopt spec: invalid empty long
option"
> + | L"help" -> invalid_arg "Getopt spec: should not have
L\"help\""
Theoretically both Arg and the current Getopt allow applications to
provide an own handler for --help, instead of the built-in one.
Sure, but I don't think that's a good idea :-)
> + | L s when String.contains s '_' ->
> + invalid_arg (sprintf "Getopt spec: L%S should not contain
'_'"
> + s)
Why this limitation?
I guess we don't need this limitation. It's there to catch accidental
underscores. If we actually have to use underscore parameters then we
can remove this later.
IMHO it'd be better to sort the specs at this point, like done
before;
otherwise, --help (and potentially any non-hidden built-in option added
here) will be shown only at the end of the other specs.
At the beginning of the list, and it was deliberate. However it's
just a matter of preference, and the options could be sorted later.
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-top is 'top' for virtual machines. Tiny program with many
powerful monitoring features, net stats, disk stats, logging, etc.
http://people.redhat.com/~rjones/virt-top
10:40 a.m.
New subject: [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.
On Monday, 18 July 2016 14:43:03 CEST Richard W.M. Jones wrote:
> > - let validate_key key =
> > - if String.length key == 0 || key == "-" || key ==
"--"
> > - || key.[0] != '-' then
> > - invalid_arg (sprintf "invalid option key: '%s'" key)
> > + let validate_key = function
> > + | L"" -> invalid_arg "Getopt spec: invalid empty long
option"
> > + | L"help" -> invalid_arg "Getopt spec: should not have
L\"help\""
>
> Theoretically both Arg and the current Getopt allow applications to
> provide an own handler for --help, instead of the built-in one.
Sure, but I don't think that's a good idea :-)
Well, I could have avoided that when proposing the final Getopt patch...
Also, there should be the same checks for M"something" of the
L"something" ones.
> IMHO it'd be better to sort the specs at this point, like
done before;
> otherwise, --help (and potentially any non-hidden built-in option added
> here) will be shown only at the end of the other specs.
At the beginning of the list, and it was deliberate. However it's
just a matter of preference, and the options could be sorted later.
Well I'd prefer it sorted, since it won't create arbitrary lines of
--help with different order, which look a bit odd.
Also, making everything ordered was basically the reason for the helper
type t, and the mutable state of its specs field.
--
Pino Toscano
10:58 a.m.
New subject: [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.
On Mon, Jul 18, 2016 at 05:40:11PM +0200, Pino Toscano wrote:
On Monday, 18 July 2016 14:43:03 CEST Richard W.M. Jones wrote:
> > > - let validate_key key =
> > > - if String.length key == 0 || key == "-" || key ==
"--"
> > > - || key.[0] != '-' then
> > > - invalid_arg (sprintf "invalid option key: '%s'"
key)
> > > + let validate_key = function
> > > + | L"" -> invalid_arg "Getopt spec: invalid empty
long option"
> > > + | L"help" -> invalid_arg "Getopt spec: should not
have L\"help\""
> >
> > Theoretically both Arg and the current Getopt allow applications to
> > provide an own handler for --help, instead of the built-in one.
>
> Sure, but I don't think that's a good idea :-)
Well, I could have avoided that when proposing the final Getopt patch...
Also, there should be the same checks for M"something" of the
L"something" ones.
How about I add this case:
let validate_key = function
+ | M s when String.length s <> 2 || (s.[0] <> 'i' && s.[0]
<> 'o') ->
+ invalid_arg "Getopt spec: invalid use of M\"...\" option - only use
this for virt-v2v -iX and -oX options"
| L"" -> invalid_arg "Getopt spec: invalid empty long option"
It effectively excludes any use of the M option except for the
special cases in virt-v2v.
> > IMHO it'd be better to sort the specs at this point,
like done before;
> > otherwise, --help (and potentially any non-hidden built-in option added
> > here) will be shown only at the end of the other specs.
>
> At the beginning of the list, and it was deliberate. However it's
> just a matter of preference, and the options could be sorted later.
Well I'd prefer it sorted, since it won't create arbitrary lines of
--help with different order, which look a bit odd.
OK, I changed the sort so it happens after the --help and other
options have been added.
Also, making everything ordered was basically the reason for the
helper
type t, and the mutable state of its specs field.
Indeed - I couldn't work out how to rewrite the code without
mutability.
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines. Supports shell scripting,
bindings from many languages. http://libguestfs.org
5:46 a.m.
New subject: [PATCH v2 3/3] mllib: tests: Add tests of the new Getopt module.
---
.gitignore | 1 +
mllib/Makefile.am | 30 ++++++++-
mllib/getopt_tests.ml | 68 ++++++++++++++++++++
mllib/test-getopt.sh | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 264 insertions(+), 2 deletions(-)
create mode 100644 mllib/getopt_tests.ml
create mode 100755 mllib/test-getopt.sh
diff --git a/.gitignore b/.gitignore
index 000e984..c1ae484 100644
--- a/.gitignore
+++ b/.gitignore
@@ -295,6 +295,7 @@ Makefile.in
/mllib/common_gettext.ml
/mllib/common_utils_tests
/mllib/dummy
+/mllib/getopt_tests
/mllib/guestfs_config.ml
/mllib/JSON_tests
/mllib/libdir.ml
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 4f50c52..dc36f26 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -162,6 +162,15 @@ common_utils_tests_CPPFLAGS = \
common_utils_tests_BOBJECTS = common_utils_tests.cmo
common_utils_tests_XOBJECTS = $(common_utils_tests_BOBJECTS:.cmo=.cmx)
+getopt_tests_SOURCES = dummy.c
+getopt_tests_CPPFLAGS = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/src
+getopt_tests_BOBJECTS = getopt_tests.cmo
+getopt_tests_XOBJECTS = $(getopt_tests_BOBJECTS:.cmo=.cmx)
+
JSON_tests_SOURCES = dummy.c
JSON_tests_BOBJECTS = JSON_tests.cmo
JSON_tests_XOBJECTS = $(JSON_tests_BOBJECTS:.cmo=.cmx)
@@ -171,16 +180,24 @@ if !HAVE_OCAMLOPT
common_utils_tests_THEOBJECTS = $(common_utils_tests_BOBJECTS)
common_utils_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+getopt_tests_THEOBJECTS = $(getopt_tests_BOBJECTS)
+getopt_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
JSON_tests_THEOBJECTS = $(JSON_tests_BOBJECTS)
JSON_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
BEST = c
OCAMLLINKFLAGS = mlguestfs.cma -custom
else
common_utils_tests_THEOBJECTS = $(common_utils_tests_XOBJECTS)
common_utils_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+getopt_tests_THEOBJECTS = $(getopt_tests_XOBJECTS)
+getopt_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
JSON_tests_THEOBJECTS = $(JSON_tests_XOBJECTS)
JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
BEST = opt
OCAMLLINKFLAGS = mlguestfs.cmxa
endif
@@ -192,6 +209,13 @@ common_utils_tests_LINK = \
$(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
$(common_utils_tests_THEOBJECTS) -o $@
+getopt_tests_DEPENDENCIES = $(getopt_tests_THEOBJECTS) $(top_srcdir)/ocaml-link.sh
+getopt_tests_LINK = \
+ $(top_srcdir)/ocaml-link.sh -cclib '-lutils $(LIBXML2_LIBS) -lgnu' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+ $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
+ $(getopt_tests_THEOBJECTS) -o $@
+
JSON_tests_DEPENDENCIES = $(JSON_tests_THEOBJECTS) $(top_srcdir)/ocaml-link.sh
JSON_tests_LINK = \
$(top_srcdir)/ocaml-link.sh -- \
@@ -201,8 +225,10 @@ JSON_tests_LINK = \
TESTS_ENVIRONMENT = $(top_builddir)/run --test
-TESTS =
-check_PROGRAMS =
+TESTS = \
+ test-getopt.sh
+check_PROGRAMS = \
+ getopt_tests
if HAVE_OCAML_PKG_OUNIT
check_PROGRAMS += common_utils_tests JSON_tests
diff --git a/mllib/getopt_tests.ml b/mllib/getopt_tests.ml
new file mode 100644
index 0000000..fb089ec
--- /dev/null
+++ b/mllib/getopt_tests.ml
@@ -0,0 +1,68 @@
+(* mllib
+ * Copyright (C) 2016 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 Getopt module. The tests are controlled by the
+ * test-getopt.sh script.
+ *)
+
+open Printf
+
+open Common_utils
+open Getopt.OptionName
+
+let adds = ref []
+let add_string = push_back adds
+
+let anons = ref []
+let anon_fun = push_back anons
+
+let ints = ref []
+let add_int = push_back ints
+
+let clear_flag = ref true
+let set_flag = ref false
+let si = ref 42
+let ss = ref "not set"
+
+let argspec = [
+ [ S 'a'; L"add" ], Getopt.String ("string", add_string),
"Add string";
+ [ S 'c'; L"clear" ], Getopt.Clear clear_flag, "Clear
flag";
+ [ S 'i'; L"int" ], Getopt.Int ("int", add_int), "Add
int";
+ [ L"si"; L"set-int" ], Getopt.Set_int ("int", si),
"Set int";
+ [ L"ss"; L"set-string"], Getopt.Set_string ("string",
ss), "Set string";
+ [ S 't'; L"set" ], Getopt.Set set_flag, "Set flag";
+]
+
+let usage_msg = sprintf "%s: test the Getopt parser" prog
+
+let opthandle = create_standard_options argspec ~anon_fun usage_msg
+let () =
+ Getopt.parse opthandle;
+
+ (* Implicit settings. *)
+ printf "trace = %b\n" (trace ());
+ printf "verbose = %b\n" (verbose ());
+
+ (* Print the results. *)
+ printf "adds = [%s]\n" (String.concat ", " !adds);
+ printf "anons = [%s]\n" (String.concat ", " !anons);
+ printf "ints = [%s]\n" (String.concat ", " (List.map string_of_int
!ints));
+ 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
diff --git a/mllib/test-getopt.sh b/mllib/test-getopt.sh
new file mode 100755
index 0000000..73a59df
--- /dev/null
+++ b/mllib/test-getopt.sh
@@ -0,0 +1,167 @@
+#!/bin/bash -
+# libguestfs
+# Copyright (C) 2016 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 Getopt module.
+# See also: getopt_tests.ml
+
+set -e
+set -x
+
+t=./getopt_tests
+
+expect_fail ()
+{
+ if "$@"; then
+ echo "$@" ": this command was expected to exit with an
error"
+ exit 1
+ fi
+}
+
+# Program works.
+$t
+
+# Flags added automatically by Common_utils.
+$t | grep '^trace = false'
+$t | grep '^verbose = false'
+
+$t -x | grep '^trace = true'
+$t --verbose | grep '^verbose = true'
+
+# --help
+$t --help | grep '^getopt_tests: test the Getopt parser'
+$t --help | grep '^Options:'
+$t --help | grep -- '-i, --int <int>'
+$t --help | grep -- '-v, --verbose'
+$t --help | grep -- '-x'
+
+# --version
+$t --version | grep '^getopt_tests 1\.'
+
+# --short-options
+$t --short-options | grep '^-a'
+$t --short-options | grep '^-c'
+$t --short-options | grep '^-i'
+$t --short-options | grep '^-q'
+$t --short-options | grep '^-t'
+$t --short-options | grep '^-V'
+$t --short-options | grep '^-v'
+$t --short-options | grep '^-x'
+
+# --long-options
+$t --long-options | grep '^--help'
+$t --long-options | grep '^--add'
+$t --long-options | grep '^--clear'
+$t --long-options | grep '^--color'
+$t --long-options | grep '^--colors'
+$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 '^--quiet'
+$t --long-options | grep '^--set'
+$t --long-options | grep '^--set-int'
+$t --long-options | grep '^--set-string'
+$t --long-options | grep '^--si'
+$t --long-options | grep '^--ss'
+$t --long-options | grep '^--version'
+$t --long-options | grep '^--verbose'
+
+# -a/--add parameter.
+$t | grep '^adds = \[\]'
+$t -a A | grep '^adds = \[A\]'
+$t -a A -a B | grep '^adds = \[A, B\]'
+$t --add A | grep '^adds = \[A\]'
+$t --add A -a B | grep '^adds = \[A, B\]'
+expect_fail $t -a
+expect_fail $t --add
+
+# -c/--clear parameter.
+$t | grep '^clear_flag = true'
+$t -c | grep '^clear_flag = false'
+$t --clear | grep '^clear_flag = false'
+
+# -i/--int parameter.
+$t | grep '^ints = \[\]'
+$t -i 1 | grep '^ints = \[1\]'
+$t -i 1 -i 2 | grep '^ints = \[1, 2\]'
+$t -i 1 --int 2 --int 3 | grep '^ints = \[1, 2, 3\]'
+expect_fail $t --int
+
+# Non-integer parameters.
+expect_fail $t --int --int
+expect_fail $t --int ""
+expect_fail $t --int ABC
+expect_fail $t --int 0.3
+expect_fail $t --int 0E
+expect_fail $t --int 0ABC
+
+# Negative and large integer parameters.
+# All int parameters must be within signed 31 bit (even on 64 bit arch),
+# and anything else should be rejected.
+$t -i -1 | grep '^ints = \[-1\]'
+$t -i -1073741824 | grep '^ints = \[-1073741824\]'
+$t -i 1073741823 | grep '^ints = \[1073741823\]'
+expect_fail $t -i -1073741825
+expect_fail $t -i 1073741824
+expect_fail $t -i -2147483648
+expect_fail $t -i 2147483647
+expect_fail $t -i -4611686018427387904
+expect_fail $t -i 4611686018427387903
+expect_fail $t -i -9223372036854775808
+expect_fail $t -i 9223372036854775807
+
+# -t/--set parameter.
+$t | grep '^set_flag = false'
+$t -t | grep '^set_flag = true'
+$t --set | grep '^set_flag = true'
+
+# --si/--set-int parameter.
+$t | grep '^set_int = 42'
+$t --si 1 | grep '^set_int = 1'
+$t --set-int 2 | grep '^set_int = 2'
+expect_fail $t --si
+expect_fail $t --set-int
+expect_fail $t --set-int -i
+expect_fail $t --set-int ""
+expect_fail $t --set-int ABC
+expect_fail $t --set-int 0.3
+expect_fail $t --set-int 1e1
+expect_fail $t --set-int 0E
+expect_fail $t --set-int 0ABC
+
+# --ss/--set-string parameter.
+$t | grep '^set_string = not set'
+$t --ss A | grep '^set_string = A'
+$t --set-string B | grep '^set_string = B'
+expect_fail $t --ss
+expect_fail $t --set-string
+
+# Anonymous parameters.
+$t | grep '^anons = \[\]'
+$t 1 | grep '^anons = \[1\]'
+$t 1 2 3 | grep '^anons = \[1, 2, 3\]'
+
+# Grouping single letter options.
+$t -cti1 | grep '^clear_flag = false'
+$t -cti1 | grep '^set_flag = true'
+$t -cti1 | grep '^ints = \[1\]'
+$t -i1 -i2 | grep '^ints = \[1, 2\]'
+
+# Short versions of long options (used by virt-v2v).
+$t -si 1 | grep '^set_int = 1'
+$t -ss A | grep '^set_string = A'
--
2.7.4
3083
days inactive
3083
days old
7 comments
2 participants
participants (2)
-
Pino Toscano -
Richard W.M. Jones