Libguestfs - Jul 2016 - [PATCH v2 1/2] v2v: register also aliases of input/output modules

Extend Modules_list to handle also aliases for input and output modules,
and use this to register the existing aliases.
---
 v2v/input_disk.ml    |  2 +-
 v2v/modules_list.ml  | 25 +++++++++++++++++++++----
 v2v/modules_list.mli |  8 ++++----
 v2v/output_local.ml  |  2 +-
 v2v/output_rhev.ml   |  2 +-
 5 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/v2v/input_disk.ml b/v2v/input_disk.ml
index 17ad61d..d21815d 100644
--- a/v2v/input_disk.ml
+++ b/v2v/input_disk.ml
@@ -101,4 +101,4 @@ class input_disk input_format disk = object
 end
 
 let input_disk = new input_disk
-let () = Modules_list.register_input_module "disk"
+let () = Modules_list.register_input_module ~alias:"local"
"disk"
diff --git a/v2v/modules_list.ml b/v2v/modules_list.ml
index 36a08c0..5649b02 100644
--- a/v2v/modules_list.ml
+++ b/v2v/modules_list.ml
@@ -21,11 +21,28 @@ open Common_utils
 let input_modules = ref []
 and output_modules = ref []
 
-let register_input_module name = push_front name input_modules
-and register_output_module name = push_front name output_modules
+let rec register_input_module ?alias name = register ?alias name input_modules
+and register_output_module ?alias name = register ?alias name output_modules
+and register ?alias name l +  push_front (name, false) l;
+  (match alias with
+  | None -> ()
+  | Some alias -> push_front (alias, true) l
+  )
 
-let input_modules () = List.sort compare !input_modules
-and output_modules () = List.sort compare !output_modules
+let list_out ~with_alias l +  let l +    if with_alias then l
+    else
+      List.filter (
+        fun (_, is_alias) ->
+          not is_alias
+      ) l in
+  let l = List.map fst l in
+  List.sort compare l
+
+let input_modules ?(with_alias = false) () = list_out ~with_alias
!input_modules
+and output_modules ?(with_alias = false) () = list_out ~with_alias
!output_modules
 
 type conversion_fn    keep_serial_console:bool ->
diff --git a/v2v/modules_list.mli b/v2v/modules_list.mli
index 0560832..7f0af4b 100644
--- a/v2v/modules_list.mli
+++ b/v2v/modules_list.mli
@@ -18,16 +18,16 @@
 
 (** List of input, output and conversion modules. *)
 
-val register_input_module : string -> unit
+val register_input_module : ?alias:string -> string -> unit
 (** Register an input module by name. *)
 
-val register_output_module : string -> unit
+val register_output_module : ?alias:string -> string -> unit
 (** Register an output module by name. *)
 
-val input_modules : unit -> string list
+val input_modules : ?with_alias:bool -> unit -> string list
 (** Return the list of input modules. *)
 
-val output_modules : unit -> string list
+val output_modules : ?with_alias:bool -> unit -> string list
 (** Return the list of output modules. *)
 
 type conversion_fn diff --git a/v2v/output_local.ml b/v2v/output_local.ml
index 47da929..ccd52f2 100644
--- a/v2v/output_local.ml
+++ b/v2v/output_local.ml
@@ -61,4 +61,4 @@ class output_local dir = object
 end
 
 let output_local = new output_local
-let () = Modules_list.register_output_module "local"
+let () = Modules_list.register_output_module ~alias:"disk"
"local"
diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml
index e45043b..90ac307 100644
--- a/v2v/output_rhev.ml
+++ b/v2v/output_rhev.ml
@@ -282,4 +282,4 @@ object
 end
 
 let output_rhev = new output_rhev
-let () = Modules_list.register_output_module "rhev"
+let () = Modules_list.register_output_module ~alias:"ovirt"
"rhev"
-- 
2.7.4

Use Getopt.Symbol for options with a fixed list of choices, so there is
no need to check them on our own.
---
 v2v/cmdline.ml | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 2d0a10a..96e0509 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -83,8 +83,7 @@ let parse_cmdline ()      | "libvirt" ->
input_mode := `Libvirt
     | "libvirtxml" -> input_mode := `LibvirtXML
     | "ova" -> input_mode := `OVA
-    | s ->
-      error (f_"unknown -i option: %s") s
+    | _ -> assert false (* Already checked by Getopt.Symbol. *)
   in
 
   let network_map = ref NetworkMap.empty in
@@ -125,8 +124,7 @@ let parse_cmdline ()      | "ovirt" |
"rhev" -> output_mode := `RHEV
     | "qemu" -> output_mode := `QEmu
     | "vdsm" -> output_mode := `VDSM
-    | s ->
-      error (f_"unknown -o option: %s") s
+    | _ -> assert false (* Already checked by Getopt.Symbol. *)
   in
 
   let output_alloc = ref `Not_set in
@@ -136,8 +134,7 @@ let parse_cmdline ()      match mode with
     | "sparse" -> output_alloc := `Sparse
     | "preallocated" -> output_alloc := `Preallocated
-    | s ->
-      error (f_"unknown -oa option: %s") s
+    | _ -> assert false (* Already checked by Getopt.Symbol. *)
   in
 
   let root_choice = ref AskRoot in
@@ -171,7 +168,7 @@ let parse_cmdline ()      [ L"dcpath";
L"dcPath" ],  Getopt.String ("path", set_string_option_once
"--dcpath" dcpath),
                                             s_"Override dcPath (for
vCenter)";
     [ 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)";
+    [ S 'i' ],        Getopt.Symbol (i_options,
Modules_list.input_modules ~with_alias:true (), set_input_mode), s_"Set
input mode (default: libvirt)";
     [ M"ic" ],       Getopt.String ("uri",
set_string_option_once "-ic" input_conn),
                                             s_"Libvirt URI";
     [ M"if" ],       Getopt.String ("format",
set_string_option_once "-if" input_format),
@@ -182,8 +179,8 @@ let parse_cmdline ()      [ 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";
-    [ 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 'o' ],        Getopt.Symbol (o_options,
Modules_list.output_modules ~with_alias:true (), set_output_mode), s_"Set
output mode (default: libvirt)";
+    [ M"oa" ],       Getopt.Symbol (s_"mode", [
"sparse"; "preallocated" ], set_output_alloc),
                                             s_"Set output allocation
mode";
     [ M"oc" ],       Getopt.String ("uri",
set_string_option_once "-oc" output_conn),
                                             s_"Libvirt URI";
-- 
2.7.4

On Tue, Jul 19, 2016 at 02:28:31PM +0200, Pino Toscano
wrote:
> Use Getopt.Symbol for options with a fixed list of choices, so there is
> no need to check them on our own.
It would sure be nice if Getopt.Symbol was smarter and could do the
full conversion from string to internal type safely.  That would
remove the need to have the type unsafe cases like:
> +    | _ -> assert false (* Already checked by Getopt.Symbol. *)
This would be trivial with a camlp4 or ppx macro.  Since we don't want
to add those packages as dependencies, how about generating code (in
the generator) to do that?

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v