mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-21 22:53:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

mllib: Use L"..." and S '...' for long and short options.

Browse Source 
There is also an M"..." variant which acts the same way as
L but handles the annoying virt-v2v two letter options.
This commit is contained in:
Richard W.M. Jones
2016-07-15 13:10:19 +01:00
parent 4ac1744db4
commit ba2cf9a2eb
16 changed files with 296 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
builder/cmdline.ml
View File

@@ -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

26
customize/customize_main.ml
View File

@@ -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

57
dib/cmdline.ml
View File

@@ -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

29
generator/customize.ml
View File

@@ -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 ()

17
get-kernel/get_kernel.ml
View File

@@ -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_"\

15
mllib/common_utils.ml
View File

@@ -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

129
mllib/getopt.ml
View File

@@ -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,65 @@ 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
| 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"
| 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 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;
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
let specs = added_options @ specs 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 +199,20 @@ 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;
t.specs <- 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

48
mllib/getopt.mli
View File

@@ -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. *)

41
resize/resize.ml
View File

@@ -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

21
sparsify/cmdline.ml
View File

@@ -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

29
sysprep/main.ml
View File

@@ -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 =

8
sysprep/sysprep_operation.ml
View File

@@ -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

5
sysprep/sysprep_operation_script.ml
View File

@@ -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

5
sysprep/sysprep_operation_user_account.ml
View File

@@ -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.

55
v2v/cmdline.ml
View File

@@ -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

5
v2v/copy_to_local.ml
View File

@@ -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