Richard W.M. Jones
2016-Jul-18 14:04 UTC
[Libguestfs] [PATCH v3 0/3] mllib: Various fixes and changes to Getopt module.
v2 -> v3: - Add M variant and test it. Rich.
Richard W.M. Jones
2016-Jul-18 14:04 UTC
[Libguestfs] [PATCH v3 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
Richard W.M. Jones
2016-Jul-18 14:04 UTC
[Libguestfs] [PATCH v3 2/3] mllib: Use L"..." and S '...' for long and short options.
There is also an M"..." variant which acts the same way as L but handles the annoying virt-v2v two letter options. --- builder/cmdline.ml | 61 +++++++------- customize/customize_main.ml | 26 +++--- dib/cmdline.ml | 57 ++++++------- generator/customize.ml | 29 +++---- get-kernel/get_kernel.ml | 17 ++-- mllib/common_utils.ml | 15 ++-- mllib/getopt.ml | 130 ++++++++++++++++-------------- mllib/getopt.mli | 48 +++++++---- 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 +- 16 files changed, 294 insertions(+), 258 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/customize/customize_main.ml b/customize/customize_main.ml index 9d22cd0..07fd790 100644 --- a/customize/customize_main.ml +++ b/customize/customize_main.ml @@ -18,6 +18,7 @@ open Common_gettext.Gettext open Common_utils +open Getopt.OptionName open Customize_utils open Customize_cmdline @@ -71,21 +72,20 @@ let main () in let argspec = [ - [ "-a"; "--add" ], Getopt.String (s_"file", add_file), s_"Add disk image file"; - [ "--attach" ], Getopt.String ("iso", attach_disk), s_"Attach data disk/ISO during install"; - [ "--attach-format" ], Getopt.String ("format", set_attach_format), + [ S 'a'; L"add" ], Getopt.String (s_"file", add_file), s_"Add disk image file"; + [ 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"; - [ "-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"; - [ "--format" ], Getopt.String (s_"format", set_format), s_"Set format (default: auto)"; - [ "-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"; + [ 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"format" ], Getopt.String (s_"format", set_format), s_"Set format (default: auto)"; + [ 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"; ] in - let customize_argspec, get_customize_ops - Customize_cmdline.argspec () 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 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..ee650eb 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 | M 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,12 @@ external getopt_parse : string array -> (c_keys * spec * doc) array -> ?anon_fun let column_wrap = 38 +(* This should only be used for --help and man pages. *) +let string_of_option_name = function + | S c -> sprintf "-%c" c + | L s -> "--" ^ s + | M s -> "-" ^ s + let show_help h () let b = Buffer.create 1024 in @@ -58,10 +69,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 +84,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 +121,10 @@ 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 c -> printf "-%c\n" c + | M s -> printf "-%s\n" s + | L _ -> () ) args ) h.specs; exit 0 @@ -119,73 +132,48 @@ 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 s | M s -> printf "--%s\n" s ) 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 string_of_option_name_no_dashes = function + | S c -> String.make 1 c + | L s | M s -> s + in + 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 +182,32 @@ 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 + let keys = List.map ( + function + | S c -> sprintf "-%c" c + | L s | M s -> sprintf "--%s" s + ) keys in + let keys = Array.of_list keys in + 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..dc5068a 100644 --- a/mllib/getopt.mli +++ b/mllib/getopt.mli @@ -18,29 +18,39 @@ 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 *) + | M of string + (** [M] should only be used in virt-v2v. Handle options like [-os]. + This works exactly like [L] except for changing the output of + [--help], and that [M] options appear in [--short-options] and + [--long-options]. *) +end +type keys = OptionName.option_name list type doc = string type usage_msg = string type anon_fun = (string -> unit) @@ -49,9 +59,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 [--help] output + and man pages. 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..2d0a10a 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)"; + [ M"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), + [ M"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)"; + [ M"oa" ], Getopt.String ("sparse|preallocated", set_output_alloc), s_"Set output allocation mode"; - [ "-oc" ], Getopt.String ("uri", set_string_option_once "-oc" output_conn), + [ M"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), + [ M"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), + [ M"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), + [ M"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
Richard W.M. Jones
2016-Jul-18 14:04 UTC
[Libguestfs] [PATCH v3 3/3] mllib: tests: Add tests of the new Getopt module.
--- .gitignore | 1 + mllib/Makefile.am | 31 ++++++++- mllib/getopt_tests.ml | 68 ++++++++++++++++++++ mllib/test-getopt.sh | 170 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 268 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 69a996d..0433b4c 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,12 +180,18 @@ 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) 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) endif @@ -193,6 +208,16 @@ common_utils_tests_LINK = \ $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \ $(common_utils_tests_THEOBJECTS) -o $@ +getopt_tests_DEPENDENCIES = \ + $(getopt_tests_THEOBJECTS) \ + $(MLLIB_CMA) \ + $(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) \ $(MLLIB_CMA) \ @@ -205,8 +230,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..ac0ff33 --- /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"; + [ M"si"; L"set-int" ], Getopt.Set_int ("int", si), "Set int"; + [ M"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..8bb7284 --- /dev/null +++ b/mllib/test-getopt.sh @@ -0,0 +1,170 @@ +#!/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 -- '-si, --set-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 '^-si' +$t --short-options | grep '^-ss' +$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
Pino Toscano
2016-Jul-18 15:41 UTC
Re: [Libguestfs] [PATCH v3 1/3] mllib: getopt: Further fix int parsing.
On Monday, 18 July 2016 15:04:37 CEST Richard W.M. Jones wrote:> 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. > ---LGTM (dammit gnulib). Thanks, -- Pino Toscano
Seemingly Similar Threads
- [PATCH] mllib: Getopt: fix integer parsing
- Re: [PATCH] mllib: Getopt: fix integer parsing
- Re: [PATCH] mllib: Getopt: fix integer parsing
- [PATCH 1/3] mllib: Getopt: point to man page as additional help
- [PATCH v3 0/3] mllib: Various fixes and changes to Getopt module.