[Pkg-libvirt-commits] [libguestfs] 147/266: v2v: Change input and output variants into classes.

Hilko Bengen bengen at moszumanska.debian.org
Fri Oct 3 14:41:54 UTC 2014


This is an automated email from the git hooks/post-receive script.

bengen pushed a commit to annotated tag debian/1%1.27.35-1
in repository libguestfs.

commit ca05d757b00359e05536b3fb01484c0b61cd0934
Author: Richard W.M. Jones <rjones at redhat.com>
Date:   Thu Aug 21 12:25:43 2014 +0100

    v2v: Change input and output variants into classes.
    
    Previously Types.input and Types.output were variants, resulting in
    the main v2v.ml code having to have knowledge of all the input and
    output types.  So you would end up with code in v2v.ml like:
    
      match output with
      | OutputLibvirt -> (* call some libvirt-specific code *)
      | OutputRHEV -> (* call some RHEV-specific code *)
    
    This changes these types to be abstract superclasses, with specific
    implementations provided by (and hidden inside) each input/output
    module.  The above code in v2v.ml now becomes:
    
      output#call ... (* no backend-specific knowledge needed *)
    
    Although this commit is very large, it is just refactoring.  There is
    no functional change in the code.
---
 po/POTFILES-ml                                 |  10 +-
 v2v/Makefile.am                                |  22 +-
 v2v/TODO                                       |   3 -
 v2v/cmdline.ml                                 |  14 +-
 v2v/convert_linux.ml                           |   2 +-
 v2v/convert_linux.mli                          |   2 +-
 v2v/input_disk.ml                              |  85 +++
 v2v/{source_disk.mli => input_disk.mli}        |   3 +-
 v2v/input_libvirt.ml                           | 304 +++++++++++
 v2v/{target_local.mli => input_libvirt.mli}    |   6 +-
 v2v/output_RHEV.ml                             | 700 +++++++++++++++++++++++++
 v2v/{source_libvirt.mli => output_RHEV.mli}    |  16 +-
 v2v/{target_libvirt.ml => output_libvirt.ml}   | 149 +++---
 v2v/{target_libvirt.mli => output_libvirt.mli} |   5 +-
 v2v/{target_local.ml => output_local.ml}       |  40 +-
 v2v/{convert_linux.mli => output_local.mli}    |   4 +-
 v2v/source_disk.ml                             |  79 ---
 v2v/source_libvirt.ml                          | 298 -----------
 v2v/target_RHEV.ml                             | 664 -----------------------
 v2v/target_RHEV.mli                            |  25 -
 v2v/types.ml                                   |  55 +-
 v2v/types.mli                                  |  42 +-
 v2v/v2v.ml                                     |  37 +-
 23 files changed, 1281 insertions(+), 1284 deletions(-)

diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 2a5ce03..2001f47 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -86,14 +86,14 @@ v2v/DOM.ml
 v2v/cmdline.ml
 v2v/convert_linux.ml
 v2v/convert_windows.ml
+v2v/input_disk.ml
+v2v/input_libvirt.ml
 v2v/lib_esx.ml
 v2v/lib_linux.ml
-v2v/source_disk.ml
-v2v/source_libvirt.ml
+v2v/output_RHEV.ml
+v2v/output_libvirt.ml
+v2v/output_local.ml
 v2v/stringMap.ml
-v2v/target_RHEV.ml
-v2v/target_libvirt.ml
-v2v/target_local.ml
 v2v/types.ml
 v2v/utils.ml
 v2v/v2v.ml
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index c4ed313..3eec99a 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -30,11 +30,11 @@ SOURCES_MLI = \
 	DOM.mli \
 	lib_esx.mli \
 	lib_linux.mli \
-	source_disk.mli \
-	source_libvirt.mli \
-	target_libvirt.mli \
-	target_local.mli \
-	target_RHEV.mli \
+	input_disk.mli \
+	input_libvirt.mli \
+	output_libvirt.mli \
+	output_local.mli \
+	output_RHEV.mli \
 	types.mli \
 	xml.mli
 
@@ -46,14 +46,14 @@ SOURCES_ML = \
 	DOM.ml \
 	lib_esx.ml \
 	lib_linux.ml \
-	cmdline.ml \
-	source_disk.ml \
-	source_libvirt.ml \
+	input_disk.ml \
+	input_libvirt.ml \
 	convert_linux.ml \
 	convert_windows.ml \
-	target_libvirt.ml \
-	target_local.ml \
-	target_RHEV.ml \
+	output_libvirt.ml \
+	output_local.ml \
+	output_RHEV.ml \
+	cmdline.ml \
 	v2v.ml
 
 SOURCES_C = \
diff --git a/v2v/TODO b/v2v/TODO
index cf78969..7d2fb98 100644
--- a/v2v/TODO
+++ b/v2v/TODO
@@ -35,6 +35,3 @@ whether the target supports writing directly to the output storage
 directory, and where that is, and then the source could use that to
 write directory.  Also s_disks would need to contain a flag to
 indicate that the main code shouldn't create overlays in this case.
-
-Consider turning inputs and outputs into classes, so
-source_libvirt -> input_libvirt which is a subclass of input.
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index c2d586a..595d97a 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -211,7 +211,7 @@ read the man page virt-v2v(1).
         | [disk] -> disk
         | _ ->
           error (f_"expecting a disk image (filename) on the command line") in
-      InputDisk (input_format, disk)
+      Input_disk.input_disk input_format disk
 
     | `Libvirt ->
       (* -i libvirt: Expecting a single argument which is the name
@@ -222,7 +222,7 @@ read the man page virt-v2v(1).
         | [guest] -> guest
         | _ ->
           error (f_"expecting a libvirt guest name on the command line") in
-      InputLibvirt (input_conn, guest)
+      Input_libvirt.input_libvirt input_conn guest
 
     | `LibvirtXML ->
       (* -i libvirtxml: Expecting a filename (XML file). *)
@@ -231,7 +231,7 @@ read the man page virt-v2v(1).
         | [filename] -> filename
         | _ ->
           error (f_"expecting a libvirt XML file name on the command line") in
-      InputLibvirtXML filename in
+      Input_libvirt.input_libvirtxml filename in
 
   (* Parse the output mode. *)
   let output =
@@ -243,7 +243,7 @@ read the man page virt-v2v(1).
         error (f_"--vmtype option can only be used with '-o rhev'");
       if not do_copy then
         error (f_"--no-copy and '-o libvirt' cannot be used at the same time");
-      OutputLibvirt (output_conn, output_storage)
+      Output_libvirt.output_libvirt output_conn output_storage
 
     | `Local ->
       if output_storage = "" then
@@ -253,18 +253,18 @@ read the man page virt-v2v(1).
           output_storage;
       if vmtype <> None then
         error (f_"--vmtype option can only be used with '-o rhev'");
-      OutputLocal output_storage
+      Output_local.output_local output_storage
 
     | `RHEV ->
       if output_storage = "" then
         error (f_"-o rhev: output storage was not specified, use '-os'");
       let rhev_params = {
-        image_uuid = rhev_image_uuid;
+        Output_RHEV.image_uuid = rhev_image_uuid;
         vol_uuids = rhev_vol_uuids;
         vm_uuid = rhev_vm_uuid;
         vmtype = vmtype;
       } in
-      OutputRHEV (output_storage, rhev_params) in
+      Output_RHEV.output_rhev ~verbose output_storage rhev_params output_alloc in
 
   input, output,
   debug_gc, do_copy, network_map,
diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml
index 58d0e99..d7343c6 100644
--- a/v2v/convert_linux.ml
+++ b/v2v/convert_linux.ml
@@ -56,7 +56,7 @@ let string_of_kernel_info ki =
     ki.ki_supports_virtio ki.ki_is_xen_kernel
 
 (* The conversion function. *)
-let rec convert ?(keep_serial_console = true) verbose (g : G.guestfs)
+let rec convert ~keep_serial_console verbose (g : G.guestfs)
     inspect source =
   (*----------------------------------------------------------------------*)
   (* Inspect the guest first.  We already did some basic inspection in
diff --git a/v2v/convert_linux.mli b/v2v/convert_linux.mli
index f55ce15..71c6435 100644
--- a/v2v/convert_linux.mli
+++ b/v2v/convert_linux.mli
@@ -16,4 +16,4 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val convert : ?keep_serial_console:bool -> bool -> Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
+val convert : keep_serial_console:bool -> bool -> Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
diff --git a/v2v/input_disk.ml b/v2v/input_disk.ml
new file mode 100644
index 0000000..85418ce
--- /dev/null
+++ b/v2v/input_disk.ml
@@ -0,0 +1,85 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 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.
+ *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Types
+open Utils
+
+class input_disk input_format disk = object
+  inherit input
+
+  method source () =
+    (* What name should we use for the guest?  We try to derive it from
+     * the filename passed in.  Users can override this using the
+     * `-on name' option.
+     *)
+    let name = Filename.chop_extension (Filename.basename disk) in
+    if name = "" then
+      error (f_"-i disk: invalid input filename (%s)") disk;
+
+    (* Get the absolute path to the disk file. *)
+    let disk_absolute =
+      if not (Filename.is_relative disk) then disk
+      else Sys.getcwd () // disk in
+
+    (* The rest of virt-v2v doesn't actually work unless we detect
+     * the format of the input, so:
+     *)
+    let format =
+      match input_format with
+      | Some format -> format
+      | None ->
+        match (new Guestfs.guestfs ())#disk_format disk with
+        | "unknown" ->
+          error (f_"cannot detect the input disk format; use the -if parameter")
+        | format -> format in
+
+    let disk = {
+      s_qemu_uri = disk_absolute;
+      s_format = Some format;
+      s_target_dev = None;
+    } in
+
+    (* Give the guest a simple generic network interface. *)
+    let network = {
+      s_mac = None;
+      s_vnet = "default";
+      s_vnet_type = Network
+    } in
+
+    let source = {
+      s_dom_type = "kvm";
+      s_name = name; s_orig_name = name;
+      s_memory = 2048L *^ 1024L *^ 1024L; (* 2048 MB *)
+      s_vcpu = 1;                         (* 1 vCPU is a safe default *)
+      s_arch = Config.host_cpu;
+      s_features = [ "acpi"; "apic"; "pae" ];
+      s_display = None;
+      s_disks = [disk];
+      s_removables = [];
+      s_nics = [network];
+    } in
+
+    source
+end
+
+let input_disk = new input_disk
diff --git a/v2v/source_disk.mli b/v2v/input_disk.mli
similarity index 85%
rename from v2v/source_disk.mli
rename to v2v/input_disk.mli
index 30b3cfd..43f1f44 100644
--- a/v2v/source_disk.mli
+++ b/v2v/input_disk.mli
@@ -18,5 +18,4 @@
 
 (** [-i disk] source. *)
 
-val create : string option -> string -> Types.source
-(** [create input_format disk] reads the disk image and returns a {!Types.source}. *)
+val input_disk : string option -> string -> Types.input
diff --git a/v2v/input_libvirt.ml b/v2v/input_libvirt.ml
new file mode 100644
index 0000000..3a3d2ba
--- /dev/null
+++ b/v2v/input_libvirt.ml
@@ -0,0 +1,304 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 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.
+ *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Types
+open Utils
+
+let identity x = x
+
+class input_libvirt
+  ?(map_source_file = identity) ?(map_source_dev = identity) xml =
+object
+  inherit input
+
+  method source () =
+    let doc = Xml.parse_memory xml in
+    let xpathctx = Xml.xpath_new_context doc in
+
+    let xpath_to_string expr default =
+      let obj = Xml.xpath_eval_expression xpathctx expr in
+      if Xml.xpathobj_nr_nodes obj < 1 then default
+      else (
+        let node = Xml.xpathobj_node doc obj 0 in
+        Xml.node_as_string node
+      )
+    and xpath_to_int expr default =
+      let obj = Xml.xpath_eval_expression xpathctx expr in
+      if Xml.xpathobj_nr_nodes obj < 1 then default
+      else (
+        let node = Xml.xpathobj_node doc obj 0 in
+        let str = Xml.node_as_string node in
+        try int_of_string str
+        with Failure "int_of_string" ->
+          error (f_"expecting XML expression to return an integer (expression: %s)")
+            expr
+      )
+    in
+
+    let dom_type = xpath_to_string "/domain/@type" "" in
+    let name = xpath_to_string "/domain/name/text()" "" in
+    let memory = xpath_to_int "/domain/memory/text()" 0 in
+    let memory = Int64.of_int memory *^ 1024L in
+    let vcpu = xpath_to_int "/domain/vcpu/text()" 0 in
+    let arch = xpath_to_string "/domain/os/type/@arch" "" in
+
+    let features =
+      let features = ref [] in
+      let obj = Xml.xpath_eval_expression xpathctx "/domain/features/*" in
+      let nr_nodes = Xml.xpathobj_nr_nodes obj in
+      for i = 0 to nr_nodes-1 do
+        let node = Xml.xpathobj_node doc obj i in
+        features := Xml.node_name node :: !features
+      done;
+      !features in
+
+    let display =
+      let obj = Xml.xpath_eval_expression xpathctx "/domain/devices/graphics" in
+      let nr_nodes = Xml.xpathobj_nr_nodes obj in
+      if nr_nodes < 1 then None
+      else (
+        (* Ignore everything except the first <graphics> device. *)
+        let node = Xml.xpathobj_node doc obj 0 in
+        Xml.xpathctx_set_current_context xpathctx node;
+        let keymap =
+          match xpath_to_string "@keymap" "" with "" -> None | k -> Some k in
+        let password =
+          match xpath_to_string "@passwd" "" with "" -> None | pw -> Some pw in
+        match xpath_to_string "@type" "" with
+        | "" -> None
+        | "vnc" ->
+          Some { s_display_type = `VNC;
+                 s_keymap = keymap; s_password = password }
+        | "spice" ->
+          Some { s_display_type = `Spice;
+                 s_keymap = keymap; s_password = password }
+        | t ->
+          warning ~prog (f_"display <graphics type='%s'> was ignored") t;
+          None
+      ) in
+
+    (* Non-removable disk devices. *)
+    let disks =
+      let get_disks, add_disk =
+        let disks = ref [] in
+        let get_disks () = List.rev !disks in
+        let add_disk qemu_uri format target_dev =
+          disks :=
+            { s_qemu_uri = qemu_uri; s_format = format;
+              s_target_dev = target_dev } :: !disks
+        in
+        get_disks, add_disk
+      in
+      let obj =
+        Xml.xpath_eval_expression xpathctx
+          "/domain/devices/disk[@device='disk']" in
+      let nr_nodes = Xml.xpathobj_nr_nodes obj in
+      if nr_nodes < 1 then
+        error (f_"this guest has no non-removable disks");
+      for i = 0 to nr_nodes-1 do
+        let node = Xml.xpathobj_node doc obj i in
+        Xml.xpathctx_set_current_context xpathctx node;
+
+        let target_dev =
+          let target_dev = xpath_to_string "target/@dev" "" in
+          if target_dev <> "" then Some target_dev else None in
+
+        let format =
+          let format = xpath_to_string "driver[@name='qemu']/@type" "" in
+          if format <> "" then Some format else None in
+
+        (* The <disk type='...'> attribute may be 'block', 'file' or
+         * 'network'.  We ignore any other types.
+         *)
+        match xpath_to_string "@type" "" with
+        | "block" ->
+          let path = xpath_to_string "source/@dev" "" in
+          if path <> "" then (
+            let path = map_source_dev path in
+            add_disk path format target_dev
+          )
+        | "file" ->
+          let path = xpath_to_string "source/@file" "" in
+          if path <> "" then (
+            let path = map_source_file path in
+            add_disk path format target_dev
+          )
+        | "network" ->
+          (* We only handle <source protocol="nbd"> here, and that is
+           * intended only for virt-p2v.  Any other network disk is
+           * currently ignored.
+           *)
+          (match xpath_to_string "source/@protocol" "" with
+          | "nbd" ->
+            let host = xpath_to_string "source/host/@name" "" in
+            let port = xpath_to_int "source/host/@port" 0 in
+            if host <> "" && port > 0 then (
+              (* Generate a qemu nbd URL.
+               * XXX Quoting, although it's not needed for virt-p2v.
+               *)
+              let path = sprintf "nbd:%s:%d" host port in
+              add_disk path format target_dev
+            )
+          | "" -> ()
+          | protocol ->
+            warning ~prog (f_"network <disk> with <source protocol='%s'> was ignored")
+              protocol
+          )
+        | disk_type ->
+          warning ~prog (f_"<disk type='%s'> was ignored") disk_type
+      done;
+      get_disks () in
+
+    (* Removable devices, CD-ROMs and floppy disks. *)
+    let removables =
+      let obj =
+        Xml.xpath_eval_expression xpathctx
+          "/domain/devices/disk[@device='cdrom' or @device='floppy']" in
+      let nr_nodes = Xml.xpathobj_nr_nodes obj in
+      let disks = ref [] in
+      for i = 0 to nr_nodes-1 do
+        let node = Xml.xpathobj_node doc obj i in
+        Xml.xpathctx_set_current_context xpathctx node;
+
+        let target_dev =
+          let target_dev = xpath_to_string "target/@dev" "" in
+          if target_dev <> "" then Some target_dev else None in
+
+        let typ =
+          match xpath_to_string "@device" "" with
+          | "cdrom" -> `CDROM
+          | "floppy" -> `Floppy
+          | _ -> assert false (* libxml2 error? *) in
+
+        let disk =
+          { s_removable_type = typ; s_removable_target_dev = target_dev } in
+        disks := disk :: !disks
+      done;
+      List.rev !disks in
+
+    (* Network interfaces. *)
+    let nics =
+      let obj = Xml.xpath_eval_expression xpathctx "/domain/devices/interface" in
+      let nr_nodes = Xml.xpathobj_nr_nodes obj in
+      let nics = ref [] in
+      for i = 0 to nr_nodes-1 do
+        let node = Xml.xpathobj_node doc obj i in
+        Xml.xpathctx_set_current_context xpathctx node;
+
+        let mac = xpath_to_string "mac/@address" "" in
+        let mac =
+          match mac with
+          | ""
+          | "00:00:00:00:00:00" (* thanks, VMware *) -> None
+          | mac -> Some mac in
+
+        let vnet_type =
+          match xpath_to_string "@type" "" with
+          | "network" -> Some Network
+          | "bridge" -> Some Bridge
+          | _ -> None in
+        match vnet_type with
+        | None -> ()
+        | Some vnet_type ->
+          let vnet = xpath_to_string "source/@network | source/@bridge" "" in
+          if vnet <> "" then (
+            let nic = { s_mac = mac; s_vnet = vnet; s_vnet_type = vnet_type } in
+            nics := nic :: !nics
+          )
+      done;
+      List.rev !nics in
+
+    {
+      s_dom_type = dom_type;
+      s_name = name; s_orig_name = name;
+      s_memory = memory;
+      s_vcpu = vcpu;
+      s_arch = arch;
+      s_features = features;
+      s_display = display;
+      s_disks = disks;
+      s_removables = removables;
+      s_nics = nics;
+    }
+end
+
+(* -i libvirtxml *)
+let input_libvirtxml file =
+  let xml = read_whole_file file in
+
+  (* When reading libvirt XML from a file (-i libvirtxml) we allow
+   * paths to disk images in the libvirt XML to be relative (to the XML
+   * file).  Relative paths are in fact not permitted in real libvirt
+   * XML, but they are very useful when dealing with test images or
+   * when writing the XML by hand.
+   *)
+  let dir = Filename.dirname (absolute_path file) in
+  let map_source_file path =
+    if not (Filename.is_relative path) then path else dir // path
+  in
+
+  new input_libvirt ~map_source_file xml
+
+(* -i libvirt [-ic libvirt_uri] *)
+let input_libvirt libvirt_uri guest =
+  (* Depending on the libvirt URI we may need to convert <source/>
+   * paths so we can access them remotely (if that is possible).  This
+   * is only true for remote, non-NULL URIs.  (We assume the user
+   * doesn't try setting $LIBVIRT_URI.  If they do that then all bets
+   * are off).
+   *)
+  let map_source_file, map_source_dev =
+    match libvirt_uri with
+    | None -> None, None
+    | Some orig_uri ->
+      let { Xml.uri_server = server; uri_scheme = scheme } as uri =
+        try Xml.parse_uri orig_uri
+        with Invalid_argument msg ->
+          error (f_"could not parse '-ic %s'.  Original error message was: %s")
+            orig_uri msg in
+      match server, scheme with
+      | None, _
+      | Some "", _ ->                   (* Not a remote URI. *)
+        None, None
+      | Some _, None                    (* No scheme? *)
+      | Some _, Some "" ->
+        None, None
+      | Some _, Some "esx" ->           (* esx://... *)
+        let f = Lib_esx.map_path_to_uri uri in Some f, Some f
+      (* XXX Missing: Look for qemu+ssh://, xen+ssh:// and use an ssh
+       * connection.  This was supported in old virt-v2v.
+       *)
+      | Some _, Some _ ->               (* Unknown remote scheme. *)
+        warning ~prog (f_"no support for remote libvirt connections to '-ic %s'.  The conversion may fail when it tries to read the source disks.")
+          orig_uri;
+        None, None in
+
+  (* Get the libvirt XML. *)
+  let cmd =
+    match libvirt_uri with
+    | None -> sprintf "virsh dumpxml %s" (quote guest)
+    | Some uri -> sprintf "virsh -c %s dumpxml %s" (quote uri) (quote guest) in
+  let lines = external_command ~prog cmd in
+  let xml = String.concat "\n" lines in
+
+  new input_libvirt ?map_source_file ?map_source_dev xml
diff --git a/v2v/target_local.mli b/v2v/input_libvirt.mli
similarity index 81%
rename from v2v/target_local.mli
rename to v2v/input_libvirt.mli
index 4907ac1..549a7a5 100644
--- a/v2v/target_local.mli
+++ b/v2v/input_libvirt.mli
@@ -16,6 +16,8 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val initialize : string -> Types.source -> Types.overlay list -> Types.overlay list
+(** [-i libvirt] and [-i libvirtxml] sources. *)
 
-val create_metadata : string -> Types.source -> Types.overlay list -> Types.guestcaps -> unit
+val input_libvirt : string option -> string -> Types.input
+
+val input_libvirtxml : string -> Types.input
diff --git a/v2v/output_RHEV.ml b/v2v/output_RHEV.ml
new file mode 100644
index 0000000..45655b3
--- /dev/null
+++ b/v2v/output_RHEV.ml
@@ -0,0 +1,700 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 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.
+ *)
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Unix
+open Printf
+
+open Types
+open Utils
+open DOM
+
+let title = sprintf "Exported by virt-v2v %s" Config.package_version
+
+type rhev_params = {
+  image_uuid : string option;
+  vol_uuids : string list;
+  vm_uuid : string option;
+  vmtype : [`Server|`Desktop] option;
+}
+
+(* Describes a mounted Export Storage Domain. *)
+type export_storage_domain = {
+  mp : string;                          (* Local mountpoint. *)
+  uuid : string;                        (* /mp/uuid *)
+}
+
+let append_child child = function
+  | PCData _ -> assert false
+  | Element e -> e.e_children <- e.e_children @ [child]
+
+(* We set the creation time to be the same for all dates in
+ * all metadata files.
+ *)
+let time = time ()
+let iso_time =
+  let tm = gmtime time in
+  sprintf "%04d/%02d/%02d %02d:%02d:%02d"
+    (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
+    tm.tm_hour tm.tm_min tm.tm_sec
+
+class output_rhev ~verbose os rhev_params output_alloc =
+object
+  inherit output
+
+  method as_options =
+    sprintf "-o rhev -os %s%s%s%s%s" os
+      (match rhev_params.image_uuid with
+      | None -> "" | Some uuid -> sprintf " --rhev-image-uuid %s" uuid)
+      (String.concat ""
+         (List.map (sprintf " --rhev-vol-uuid %s") rhev_params.vol_uuids))
+      (match rhev_params.vm_uuid with
+      | None -> "" | Some uuid -> sprintf " --rhev-vm-uuid %s" uuid)
+      (match rhev_params.vmtype with
+      | None -> ""
+      | Some `Server -> " --vmtype server"
+      | Some `Desktop -> " --vmtype desktop")
+
+  (* RHEV doesn't support serial consoles.  This causes the conversion
+   * step to remove it.
+   *)
+  method keep_serial_console = false
+
+  (* Export Storage Domain mountpoint. *)
+  val mutable esd = { mp = ""; uuid = "" }
+  (* Target image directory, UUID. *)
+  val mutable image_dir = ""
+  val mutable image_uuid = ""
+  (* Target VM UUID. *)
+  val mutable vm_uuid = ""
+  (* Flag to indicate if the target image (image_dir) should be
+   * deleted.  This is set to false once we know the conversion was
+   * successful.
+   *)
+  val mutable delete_target_directory = true
+
+  (* This is called early on in the conversion and lets us choose the
+   * name of the target files that eventually get written by the main
+   * code.
+   *
+   * 'os' is the output storage (-os nfs:/export).  'source' contains a
+   * few useful fields such as the guest name.  'overlays' describes the
+   * destination files.  We modify and return this list.
+   *
+   * Note it's good to fail here (early) if there are any problems, since
+   * the next time we are called (in {!create_metadata}) we have already
+   * done the conversion and copy, and the user won't thank us for
+   * displaying errors there.
+   *)
+  method prepare_output _ overlays =
+    let rec mount_and_check_export_storage_domain () =
+      (* The user can either specify -os nfs:/export, or a local directory
+       * which is assumed to be the already-mounted NFS export.  In either
+       * case we need to check that we have sufficient permissions to write
+       * to this mountpoint.
+       *)
+      match string_split ":/" os with
+      | mp, "" ->                     (* Already mounted directory. *)
+        check_export_storage_domain os mp
+      | server, export ->
+        let export = "/" ^ export in
+
+        (* Try mounting it. *)
+        let mp = Mkdtemp.temp_dir "v2v." "" in
+        let cmd =
+          sprintf "mount %s:%s %s" (quote server) (quote export) (quote mp) in
+        if verbose then printf "%s\n%!" cmd;
+        if Sys.command cmd <> 0 then
+          error (f_"mount command failed, see earlier errors.\n\nThis probably means you didn't specify the right Export Storage Domain path [-os %s], or else you need to rerun virt-v2v as root.") os;
+
+        (* Make sure it is unmounted at exit. *)
+        at_exit (fun () ->
+          let cmd = sprintf "umount %s" (quote mp) in
+          if verbose then printf "%s\n%!" cmd;
+          ignore (Sys.command cmd);
+          try rmdir mp with _ -> ()
+        );
+
+        check_export_storage_domain os mp
+
+    and check_export_storage_domain os mp =
+      (* Typical ESD mountpoint looks like this:
+       * $ ls /tmp/mnt
+       * 39b6af0e-1d64-40c2-97e4-4f094f1919c7  __DIRECT_IO_TEST__  lost+found
+       * $ ls /tmp/mnt/39b6af0e-1d64-40c2-97e4-4f094f1919c7
+       * dom_md  images  master
+       * We expect exactly one of those magic UUIDs.
+       *)
+      let entries =
+        try Sys.readdir mp
+        with Sys_error msg ->
+          error (f_"could not read the Export Storage Domain specified by the '-os %s' parameter on the command line.  Is it really an OVirt or RHEV-M Export Storage Domain?  The original error is: %s") os msg in
+      let entries = Array.to_list entries in
+      let uuids = List.filter (
+        fun entry ->
+          String.length entry = 36 &&
+          entry.[8] = '-' && entry.[13] = '-' && entry.[18] = '-' &&
+          entry.[23] = '-'
+      ) entries in
+      let uuid =
+        match uuids with
+        | [uuid] -> uuid
+        | [] ->
+          error (f_"there are no UUIDs in the Export Storage Domain (%s).  Is it really an OVirt or RHEV-M Export Storage Domain?") os
+        | _::_ ->
+          error (f_"there are multiple UUIDs in the Export Storage Domain (%s).  This is unexpected, and may be a bug in virt-v2v or OVirt.") os in
+
+      (* Check that the domain has been attached to a Data Center by
+       * checking that the master/vms directory exists.
+       *)
+      if not (is_directory (mp // uuid // "master" // "vms")) then
+        error (f_"the Export Storage Domain (%s) has not been attached to any Data Center.\n\nYou have to do this through the RHEV-M / OVirt user interface first.") os;
+
+      (* Check that the ESD is writable. *)
+      let testfile = mp // uuid // "v2v-write-test" in
+      let write_test_failed err =
+        error (f_"the Export Storage Domain (%s) is not writable.\n\nThis probably means you need to run virt-v2v as 'root'.\n\nOriginal error was: %s") os err;
+      in
+      (try
+         let chan = open_out testfile in
+         close_out chan;
+         unlink testfile
+       with
+       | Sys_error err -> write_test_failed err
+       | Unix_error (code, _, _) -> write_test_failed (error_message code)
+      );
+
+      (* Looks good, so return the ESD object. *)
+      { mp = mp; uuid = uuid }
+    in
+
+    (* Create unique UUIDs for everything, either based on the command
+     * line parameters or else we invent them here.
+     *)
+    let create_uuids () =
+      let image_uuid =
+        match rhev_params.image_uuid with
+        | Some uuid -> uuid
+        | None -> uuidgen ~prog () in
+      let vm_uuid =
+        match rhev_params.vm_uuid with
+        | Some uuid -> uuid
+        | None -> uuidgen ~prog () in
+
+      (* ... and for volumes. *)
+      let overlays =
+        match rhev_params.vol_uuids with
+        | [] ->
+          List.map (
+            fun ov ->
+              let uuid = uuidgen ~prog () in
+              { ov with ov_vol_uuid = uuid }
+          ) overlays
+        | uuids ->
+          try
+            List.map (
+              fun (ov, uuid) -> { ov with ov_vol_uuid = uuid }
+            ) (List.combine overlays uuids)
+          with Invalid_argument _ ->
+            error (f_"the number of '--rhev-vol-uuid' parameters passed on the command line has to match the number of guest disk images (for this guest: %d)")
+              (List.length overlays) in
+
+      image_uuid, vm_uuid, overlays
+    in
+
+    esd <- mount_and_check_export_storage_domain ();
+    if verbose then
+      eprintf "RHEV: ESD mountpoint: %s\nRHEV: ESD UUID: %s\n%!"
+        esd.mp esd.uuid;
+
+    let overlays =
+      let _image_uuid, _vm_uuid, overlays = create_uuids () in
+      image_uuid <- _image_uuid;
+      vm_uuid <- _vm_uuid;
+      overlays in
+
+    (* We need to create the target image directory so there's a place
+     * for the main program to copy the images to.  However if image
+     * conversion fails for any reason then we delete this directory.
+     *)
+    image_dir <- esd.mp // esd.uuid // "images" // image_uuid;
+    mkdir image_dir 0o755;
+    at_exit (fun () ->
+      if delete_target_directory then (
+        let cmd = sprintf "rm -rf %s" (quote image_dir) in
+        ignore (Sys.command cmd)
+      )
+    );
+    if verbose then
+      eprintf "RHEV: export directory: %s\n%!" image_dir;
+
+    (* This loop has two purposes: (1) Generate the randomly named
+     * target files (just the names).  (2) Generate the .meta file
+     * associated with each volume.  At the end we have a directory
+     * structure like this:
+     *   /<MP>/<ESD_UUID>/images/<IMAGE_UUID>/
+     *      <VOL_UUID_1>        # first disk - will be created by main code
+     *      <VOL_UUID_1>.meta   # first disk
+     *      <VOL_UUID_2>        # second disk - will be created by main code
+     *      <VOL_UUID_2>.meta   # second disk
+     *      <VOL_UUID_3>        # etc
+     *      <VOL_UUID_3>.meta   #
+     *)
+    let overlays =
+      let output_alloc_for_rhev =
+        match output_alloc with
+        | `Sparse -> "SPARSE"
+        | `Preallocated -> "PREALLOCATED" in
+
+      List.map (
+        fun ov ->
+          let target_file = image_dir // ov.ov_vol_uuid in
+
+          if verbose then
+            eprintf "RHEV: will export %s to %s\n%!" ov.ov_sd target_file;
+
+          (* Create the per-volume metadata (.meta files, in an oVirt-
+           * specific format).
+           *)
+          let vol_meta = target_file ^ ".meta" in
+
+          let size_in_sectors =
+            if ov.ov_virtual_size &^ 511L <> 0L then
+              error (f_"the virtual size of the input disk %s is not an exact multiple of 512 bytes.  The virtual size is: %Ld.\n\nThis probably means something unexpected is going on, so please file a bug about this issue.") ov.ov_source_file ov.ov_virtual_size;
+            ov.ov_virtual_size /^ 512L in
+
+          let format_for_rhev =
+            match ov.ov_target_format with
+            | "raw" -> "RAW"
+            | "qcow2" -> "COW"
+            | _ ->
+              error (f_"RHEV does not support the output format '%s', only raw or qcow2") ov.ov_target_format in
+
+          let chan = open_out vol_meta in
+          let fpf fs = fprintf chan fs in
+          fpf "DOMAIN=%s\n" esd.uuid; (* "Domain" as in Export Storage Domain *)
+          fpf "VOLTYPE=LEAF\n";
+          fpf "CTIME=%.0f\n" time;
+          fpf "MTIME=%.0f\n" time;
+          fpf "IMAGE=%s\n" image_uuid;
+          fpf "DISKTYPE=1\n";
+          fpf "PUUID=00000000-0000-0000-0000-000000000000\n";
+          fpf "LEGALITY=LEGAL\n";
+          fpf "POOL_UUID=\n";
+          fpf "SIZE=%Ld\n" size_in_sectors;
+          fpf "FORMAT=%s\n" format_for_rhev;
+          fpf "TYPE=%s\n" output_alloc_for_rhev;
+          fpf "DESCRIPTION=%s\n" title;
+          fpf "EOF\n";
+          close_out chan;
+
+          { ov with ov_target_file = target_file }
+      ) overlays in
+
+    (* Return the list of overlays. *)
+    overlays
+
+  (* This is called after conversion to write the OVF metadata. *)
+  method create_metadata source overlays guestcaps inspect =
+    (* Guess vmtype based on the guest inspection data. *)
+    let get_vmtype = function
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
+          i_product_name = product }
+          when major >= 5 && string_find product "Server" >= 0 ->
+        `Server
+
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = major }
+          when major >= 5 ->
+        `Desktop
+
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
+          i_product_name = product }
+          when major >= 3 && string_find product "ES" >= 0 ->
+        `Server
+
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
+          i_product_name = product }
+          when major >= 3 && string_find product "AS" >= 0 ->
+        `Server
+
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = major }
+          when major >= 3 ->
+        `Desktop
+
+      | { i_type = "linux"; i_distro = "fedora" } -> `Desktop
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 1 } ->
+        `Desktop                            (* Windows XP *)
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
+          i_product_name = product } when string_find product "XP" >= 0 ->
+        `Desktop                            (* Windows XP *)
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 2 } ->
+        `Server                            (* Windows 2003 *)
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
+          i_product_name = product } when string_find product "Server" >= 0 ->
+        `Server                            (* Windows 2008 *)
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 0 } ->
+        `Desktop                            (* Vista *)
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
+          i_product_name = product } when string_find product "Server" >= 0 ->
+        `Server                             (* Windows 2008R2 *)
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 1 } ->
+        `Server                             (* Windows 7 *)
+
+      | _ -> `Server
+
+    and get_ostype = function
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = v;
+          i_arch = "i386" } ->
+        sprintf "RHEL%d" v
+
+      | { i_type = "linux"; i_distro = "rhel"; i_major_version = v;
+          i_arch = "x86_64" } ->
+        sprintf "RHEL%dx64" v
+
+      | { i_type = "linux" } -> "OtherLinux"
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 1 } ->
+        "WindowsXP" (* no architecture differentiation of XP on RHEV *)
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
+          i_product_name = product } when string_find product "XP" >= 0 ->
+        "WindowsXP" (* no architecture differentiation of XP on RHEV *)
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
+          i_arch = "i386" } ->
+        "Windows2003"
+
+      | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
+          i_arch = "x86_64" } ->
+        "Windows2003x64"
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
+          i_arch = "i386" } ->
+        "Windows2008"
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
+          i_arch = "x86_64" } ->
+        "Windows2008x64"
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
+          i_arch = "i386" } ->
+        "Windows7"
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
+          i_arch = "x86_64"; i_product_variant = "Client" } ->
+        "Windows7x64"
+
+      | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
+          i_arch = "x86_64" } ->
+        "Windows2008R2x64"
+
+      | { i_type = typ; i_distro = distro;
+          i_major_version = major; i_minor_version = minor;
+          i_product_name = product } ->
+        warning ~prog (f_"unknown guest operating system: %s %s %d.%d (%s)")
+          typ distro major minor product;
+        "Unassigned"
+    in
+
+    (* This modifies the OVF DOM, adding a section for each disk. *)
+    let rec add_disks ovf =
+      let references =
+        let nodes = path_to_nodes ovf ["ovf:Envelope"; "References"] in
+        match nodes with
+        | [] | _::_::_ -> assert false
+        | [node] -> node in
+      let disk_section =
+        let sections = path_to_nodes ovf ["ovf:Envelope"; "Section"] in
+        try find_node_by_attr sections ("xsi:type", "ovf:DiskSection_Type")
+        with Not_found -> assert false in
+      let virtualhardware_section =
+        let sections = path_to_nodes ovf ["ovf:Envelope"; "Content"; "Section"] in
+        try find_node_by_attr sections ("xsi:type", "ovf:VirtualHardwareSection_Type")
+        with Not_found -> assert false in
+
+      (* Iterate over the disks, adding them to the OVF document. *)
+      iteri (
+        fun i ov ->
+          let is_boot_drive = i == 0 in
+
+          let vol_uuid = ov.ov_vol_uuid in
+          assert (vol_uuid <> "");
+
+          let fileref = image_uuid // vol_uuid in
+
+          let size_gb =
+            Int64.to_float ov.ov_virtual_size /. 1024. /. 1024. /. 1024. in
+          let usage_gb =
+            (* In the --no-copy case it can happen that the target file
+             * does not exist.  In that case we simply omit the
+             * ovf:actual_size attribute.
+             *)
+            if Sys.file_exists ov.ov_target_file then (
+              let usage_mb = du_m ov.ov_target_file in
+              if usage_mb > 0L then (
+                let usage_mb = Int64.to_float usage_mb /. 1024. in
+                Some usage_mb
+              ) else None
+            ) else None in
+
+          let format_for_rhev =
+            match ov.ov_target_format with
+            | "raw" -> "RAW"
+            | "qcow2" -> "COW"
+            | _ ->
+              error (f_"RHEV does not support the output format '%s', only raw or qcow2") ov.ov_target_format in
+
+          let output_alloc_for_rhev =
+            match output_alloc with
+            | `Sparse -> "SPARSE"
+            | `Preallocated -> "PREALLOCATED" in
+
+          (* Add disk to <References/> node. *)
+          let disk =
+            e "File" [
+              "ovf:href", fileref;
+              "ovf:id", vol_uuid;
+              "ovf:size", Int64.to_string ov.ov_virtual_size;
+              "ovf:description", title;
+            ] [] in
+          append_child disk references;
+
+          (* Add disk to DiskSection. *)
+          let disk =
+            let attrs = [
+              "ovf:diskId", vol_uuid;
+              "ovf:size", sprintf "%.1f" size_gb;
+              "ovf:fileRef", fileref;
+              "ovf:parentRef", "";
+              "ovf:vm_snapshot_id", uuidgen ~prog ();
+              "ovf:volume-format", format_for_rhev;
+              "ovf:volume-type", output_alloc_for_rhev;
+              "ovf:format", "http://en.wikipedia.org/wiki/Byte"; (* wtf? *)
+              "ovf:disk-interface",
+              if guestcaps.gcaps_block_bus = "virtio" then "VirtIO" else "IDE";
+              "ovf:disk-type", "System"; (* RHBZ#744538 *)
+              "ovf:boot", if is_boot_drive then "True" else "False";
+            ] in
+            let attrs =
+              match usage_gb with
+              | None -> attrs
+              | Some usage_gb ->
+                ("ovf:actual_size", sprintf "%.1f" usage_gb) :: attrs in
+            e "Disk" attrs [] in
+          append_child disk disk_section;
+
+          (* Add disk to VirtualHardware. *)
+          let item =
+            e "Item" [] [
+              e "rasd:InstanceId" [] [PCData vol_uuid];
+              e "rasd:ResourceType" [] [PCData "17"];
+              e "rasd:HostResource" [] [PCData fileref];
+              e "rasd:Parent" [] [PCData "00000000-0000-0000-0000-000000000000"];
+              e "rasd:Template" [] [PCData "00000000-0000-0000-0000-000000000000"];
+              e "rasd:ApplicationList" [] [];
+              e "rasd:StorageId" [] [PCData esd.uuid];
+              e "rasd:StoragePoolId" [] [PCData "00000000-0000-0000-0000-000000000000"];
+              e "rasd:CreationDate" [] [PCData iso_time];
+              e "rasd:LastModified" [] [PCData iso_time];
+              e "rasd:last_modified_date" [] [PCData iso_time];
+            ] in
+          append_child item virtualhardware_section;
+      ) overlays
+
+    and du_m filename =
+      (* There's no OCaml binding for st_blocks, so run coreutils 'du -m'
+       * to get the used size in megabytes.
+       *)
+      let cmd = sprintf "du -m %s | awk '{print $1}'" (quote filename) in
+      let lines = external_command ~prog cmd in
+      (* We really don't want the metadata generation to fail because
+       * of some silly usage information, so ignore errors here.
+       *)
+      match lines with
+      | line::_ -> (try Int64.of_string line with _ -> 0L)
+      | [] -> 0L
+    in
+
+    (* This modifies the OVF DOM, adding a section for each NIC. *)
+    let add_networks ovf =
+      let nics = source.s_nics in
+      let network_section =
+        let sections = path_to_nodes ovf ["ovf:Envelope"; "Section"] in
+        try find_node_by_attr sections ("xsi:type", "ovf:NetworkSection_Type")
+        with Not_found -> assert false in
+      let virtualhardware_section =
+        let sections = path_to_nodes ovf ["ovf:Envelope"; "Content"; "Section"] in
+        try find_node_by_attr sections ("xsi:type", "ovf:VirtualHardwareSection_Type")
+        with Not_found -> assert false in
+
+      (* Iterate over the NICs, adding them to the OVF document. *)
+      iteri (
+        fun i { s_mac = mac; s_vnet_type = vnet_type; s_vnet = vnet } ->
+          let dev = sprintf "eth%d" i in
+
+          let model =
+            match guestcaps.gcaps_net_bus with
+            | "rtl8139" -> "1"
+            | "e1000" -> "2"
+            | "virtio" -> "3"
+            | bus ->
+              warning ~prog (f_"unknown NIC model %s for ethernet device %s.  This NIC will be imported as rtl8139 instead.")
+                bus dev;
+              "1" in
+
+          let network = e "Network" ["ovf:name", vnet] [] in
+          append_child network network_section;
+
+          let item =
+            let children = [
+              e "rasd:InstanceId" [] [PCData "3"];
+              e "rasd:Caption" [] [PCData (sprintf "Ethernet adapter on %s" vnet)];
+              e "rasd:ResourceType" [] [PCData "10"];
+              e "rasd:ResourceSubType" [] [PCData model];
+              e "rasd:Connection" [] [PCData vnet];
+              e "rasd:Name" [] [PCData dev];
+            ] in
+            let children =
+              match mac with
+              | None -> children
+              | Some mac -> children @ [e "rasd:MACAddress" [] [PCData mac]] in
+            e "Item" [] children in
+          append_child item virtualhardware_section;
+      ) nics
+    in
+
+    let memsize_mb = source.s_memory /^ 1024L /^ 1024L in
+
+    let vmtype =
+      match rhev_params.vmtype with
+      | Some vmtype -> vmtype
+      | None -> get_vmtype inspect in
+    let vmtype = match vmtype with `Desktop -> "DESKTOP" | `Server -> "SERVER" in
+    let ostype = get_ostype inspect in
+
+    let ovf : doc =
+      doc "ovf:Envelope" [
+        "xmlns:rasd", "http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_ResourceAllocationSettingData";
+        "xmlns:vssd", "http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_VirtualSystemSettingData";
+        "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance";
+        "xmlns:ovf", "http://schemas.dmtf.org/ovf/envelope/1/";
+        "ovf:version", "0.9"
+      ] [
+        e "References" [] [];
+        e "Section" ["xsi:type", "ovf:NetworkSection_Type"] [
+          e "Info" [] [PCData "List of networks"]
+        ];
+        e "Section" ["xsi:type", "ovf:DiskSection_Type"] [
+          e "Info" [] [PCData "List of Virtual Disks"]
+        ];
+        e "Content" ["ovf:id", "out"; "xsi:type", "ovf:VirtualSystem_Type"] [
+          e "Name" [] [PCData source.s_name];
+          e "TemplateId" [] [PCData "00000000-0000-0000-0000-000000000000"];
+          e "TemplateName" [] [PCData "Blank"];
+          e "Description" [] [PCData title];
+          e "Domain" [] [];
+          e "CreationDate" [] [PCData iso_time];
+          e "IsInitilized" [] [PCData "True"];
+          e "IsAutoSuspend" [] [PCData "False"];
+          e "TimeZone" [] [];
+          e "IsStateless" [] [PCData "False"];
+          e "Origin" [] [PCData "0"];
+          e "VmType" [] [PCData vmtype];
+          e "DefaultDisplayType" [] [PCData "1"];
+
+          e "Section" ["ovf:id", vm_uuid; "ovf:required", "false";
+                       "xsi:type", "ovf:OperatingSystemSection_Type"] [
+            e "Info" [] [PCData "Guest Operating System"];
+            e "Description" [] [PCData ostype];
+          ];
+
+          e "Section" ["xsi:type", "ovf:VirtualHardwareSection_Type"] [
+            e "Info" [] [PCData (sprintf "%d CPU, %Ld Memory" source.s_vcpu memsize_mb)];
+            e "Item" [] [
+              e "rasd:Caption" [] [PCData (sprintf "%d virtual cpu" source.s_vcpu)];
+              e "rasd:Description" [] [PCData "Number of virtual CPU"];
+              e "rasd:InstanceId" [] [PCData "1"];
+              e "rasd:ResourceType" [] [PCData "3"];
+              e "rasd:num_of_sockets" [] [PCData (string_of_int source.s_vcpu)];
+              e "rasd:cpu_per_socket"[] [PCData "1"];
+            ];
+            e "Item" [] [
+              e "rasd:Caption" [] [PCData (sprintf "%Ld MB of memory" memsize_mb)];
+              e "rasd:Description" [] [PCData "Memory Size"];
+              e "rasd:InstanceId" [] [PCData "2"];
+              e "rasd:ResourceType" [] [PCData "4"];
+              e "rasd:AllocationUnits" [] [PCData "MegaBytes"];
+              e "rasd:VirtualQuantity" [] [PCData (Int64.to_string memsize_mb)];
+            ];
+            e "Item" [] [
+              e "rasd:Caption" [] [PCData "USB Controller"];
+              e "rasd:InstanceId" [] [PCData "4"];
+              e "rasd:ResourceType" [] [PCData "23"];
+              e "rasd:UsbPolicy" [] [PCData "Disabled"];
+            ];
+            e "Item" [] [
+              e "rasd:Caption" [] [PCData "Graphical Controller"];
+              e "rasd:InstanceId" [] [PCData "5"];
+              e "rasd:ResourceType" [] [PCData "20"];
+              e "rasd:VirtualQuantity" [] [PCData "1"];
+              e "rasd:Device" [] [PCData "qxl"];
+            ]
+          ]
+        ]
+      ] in
+
+    (* Add disks to the OVF XML. *)
+    add_disks ovf;
+
+    (* Old virt-v2v ignored removable media. XXX *)
+
+    (* Add networks to the OVF XML. *)
+    add_networks ovf;
+
+    (* Old virt-v2v didn't really look at the video and display
+     * metadata, instead just adding a single standard display (see
+     * above).  However it did warn if there was a password on the
+     * display of the old guest.
+     *)
+    (match source with
+    | { s_display = Some { s_password = Some _ } } ->
+      warning ~prog (f_"This guest required a password for connection to its display, but this is not supported by RHEV.  Therefore the converted guest's display will not require a separate password to connect.");
+    | _ -> ());
+
+    (* Write it to the metadata file. *)
+    let dir = esd.mp // esd.uuid // "master" // "vms" // vm_uuid in
+    mkdir dir 0o755;
+    let file = dir // vm_uuid ^ ".ovf" in
+    let chan = open_out file in
+    doc_to_chan chan ovf;
+    close_out chan;
+
+    (* Finished, so don't delete the target directory on exit. *)
+    delete_target_directory <- false
+end
+
+let output_rhev = new output_rhev
diff --git a/v2v/source_libvirt.mli b/v2v/output_RHEV.mli
similarity index 62%
rename from v2v/source_libvirt.mli
rename to v2v/output_RHEV.mli
index 1e3b1e1..1e3d4f1 100644
--- a/v2v/source_libvirt.mli
+++ b/v2v/output_RHEV.mli
@@ -16,12 +16,14 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-(** [-i libvirt] and [-i libvirtxml] sources. *)
+(** [-o rhev] target. *)
 
-val create : string option -> string -> Types.source
-(** [create libvirt_uri guest] reads the source metadata from the
-    named libvirt guest. *)
+type rhev_params = {
+  image_uuid : string option;           (* --rhev-image-uuid *)
+  vol_uuids : string list;              (* --rhev-vol-uuid (multiple) *)
+  vm_uuid : string option;              (* --rhev-vm-uuid *)
+  vmtype : [`Server|`Desktop] option;   (* --vmtype *)
+}
+(** Miscellaneous extra command line parameters used by RHEV. *)
 
-val create_from_xml : string -> Types.source
-(** [create_from_xml filename] reads the source metadata from the
-    libvirt XML file. *)
+val output_rhev : verbose:bool -> string -> rhev_params -> [`Sparse|`Preallocated] -> Types.output
diff --git a/v2v/target_libvirt.ml b/v2v/output_libvirt.ml
similarity index 66%
rename from v2v/target_libvirt.ml
rename to v2v/output_libvirt.ml
index a2240d5..8403f5b 100644
--- a/v2v/target_libvirt.ml
+++ b/v2v/output_libvirt.ml
@@ -187,73 +187,84 @@ let create_libvirt_xml ?pool source overlays guestcaps =
 
   doc
 
-let initialize oc output_pool source overlays =
-  (* Connect to output libvirt instance and check that the pool exists
-   * and dump out its XML.
-   *)
-  let cmd =
-    match oc with
-    | None -> sprintf "virsh pool-dumpxml %s" (quote output_pool)
-    | Some uri ->
-      sprintf "virsh -c %s dumpxml %s" (quote uri) (quote output_pool) in
-  let lines = external_command ~prog cmd in
-  let xml = String.concat "\n" lines in
-  let doc = Xml.parse_memory xml in
-  let xpathctx = Xml.xpath_new_context doc in
-
-  let xpath_to_string expr default =
-    let obj = Xml.xpath_eval_expression xpathctx expr in
-    if Xml.xpathobj_nr_nodes obj < 1 then default
-    else (
-      let node = Xml.xpathobj_node doc obj 0 in
-      Xml.node_as_string node
-    )
-  in
-
-  (* We can only output to a pool of type 'dir' (directory). *)
-  let pool_type = xpath_to_string "/pool/@type" "" in
-  if pool_type <> "dir" then
-    error (f_"-o libvirt: output pool '%s' is not a directory (type='dir').  See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool;
-  let target_path = xpath_to_string "/pool/target/path/text()" "" in
-  if target_path = "" || not (is_directory target_path) then
-    error (f_"-o libvirt: output pool '%s' has type='dir' but the /pool/target/path element either does not exist or is not a local directory.  See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool;
-
-  (* Set up the overlays. *)
-  List.map (
-    fun ov ->
-      let target_file = target_path // source.s_name ^ "-" ^ ov.ov_sd in
-      { ov with ov_target_file = target_file }
-  ) overlays
-
-let create_metadata oc output_pool source overlays guestcaps =
-  (* We copied directly into the final pool directory.  However we
-   * have to tell libvirt.
-   *)
-  let cmd =
-    match oc with
-    | None -> sprintf "virsh pool-refresh %s" (quote output_pool)
-    | Some uri ->
-      sprintf "virsh -c %s pool-refresh %s"
-        (quote uri) (quote output_pool) in
-  if Sys.command cmd <> 0 then
-    warning ~prog (f_"could not refresh libvirt pool %s") output_pool;
-
-  (* Create the metadata. *)
-  let doc = create_libvirt_xml ~pool:output_pool source overlays guestcaps in
-
-  let tmpfile, chan = Filename.open_temp_file "v2vlibvirt" ".xml" in
-  DOM.doc_to_chan chan doc;
-  close_out chan;
-
-  (* Define the domain in libvirt. *)
-  let cmd =
+class output_libvirt oc output_pool = object
+  inherit output
+
+  method as_options =
     match oc with
-    | None -> sprintf "virsh define %s" (quote tmpfile)
-    | Some uri ->
-      sprintf "virsh -c %s define %s" (quote uri) (quote tmpfile) in
-  if Sys.command cmd = 0 then (
-    try Unix.unlink tmpfile with _ -> ()
-  ) else (
-    warning ~prog (f_"could not define libvirt domain.  The libvirt XML is still available in '%s'.  Try running 'virsh define %s' yourself instead.")
-      tmpfile tmpfile
-  );
+    | None -> sprintf "-o libvirt -os %s" output_pool
+    | Some uri -> sprintf "-o libvirt -oc %s -os %s" uri output_pool
+
+  method prepare_output source overlays =
+    (* Connect to output libvirt instance and check that the pool exists
+     * and dump out its XML.
+     *)
+    let cmd =
+      match oc with
+      | None -> sprintf "virsh pool-dumpxml %s" (quote output_pool)
+      | Some uri ->
+        sprintf "virsh -c %s dumpxml %s" (quote uri) (quote output_pool) in
+    let lines = external_command ~prog cmd in
+    let xml = String.concat "\n" lines in
+    let doc = Xml.parse_memory xml in
+    let xpathctx = Xml.xpath_new_context doc in
+
+    let xpath_to_string expr default =
+      let obj = Xml.xpath_eval_expression xpathctx expr in
+      if Xml.xpathobj_nr_nodes obj < 1 then default
+      else (
+        let node = Xml.xpathobj_node doc obj 0 in
+        Xml.node_as_string node
+      )
+    in
+
+    (* We can only output to a pool of type 'dir' (directory). *)
+    let pool_type = xpath_to_string "/pool/@type" "" in
+    if pool_type <> "dir" then
+      error (f_"-o libvirt: output pool '%s' is not a directory (type='dir').  See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool;
+    let target_path = xpath_to_string "/pool/target/path/text()" "" in
+    if target_path = "" || not (is_directory target_path) then
+      error (f_"-o libvirt: output pool '%s' has type='dir' but the /pool/target/path element either does not exist or is not a local directory.  See virt-v2v(1) section \"OUTPUT TO LIBVIRT\"") output_pool;
+
+    (* Set up the overlays. *)
+    List.map (
+      fun ov ->
+        let target_file = target_path // source.s_name ^ "-" ^ ov.ov_sd in
+        { ov with ov_target_file = target_file }
+    ) overlays
+
+  method create_metadata source overlays guestcaps _ =
+    (* We copied directly into the final pool directory.  However we
+     * have to tell libvirt.
+     *)
+    let cmd =
+      match oc with
+      | None -> sprintf "virsh pool-refresh %s" (quote output_pool)
+      | Some uri ->
+        sprintf "virsh -c %s pool-refresh %s"
+          (quote uri) (quote output_pool) in
+    if Sys.command cmd <> 0 then
+      warning ~prog (f_"could not refresh libvirt pool %s") output_pool;
+
+    (* Create the metadata. *)
+    let doc = create_libvirt_xml ~pool:output_pool source overlays guestcaps in
+
+    let tmpfile, chan = Filename.open_temp_file "v2vlibvirt" ".xml" in
+    DOM.doc_to_chan chan doc;
+    close_out chan;
+
+    (* Define the domain in libvirt. *)
+    let cmd =
+      match oc with
+      | None -> sprintf "virsh define %s" (quote tmpfile)
+      | Some uri ->
+        sprintf "virsh -c %s define %s" (quote uri) (quote tmpfile) in
+    if Sys.command cmd = 0 then (
+      try Unix.unlink tmpfile with _ -> ()
+    ) else (
+      warning ~prog (f_"could not define libvirt domain.  The libvirt XML is still available in '%s'.  Try running 'virsh define %s' yourself instead.")
+        tmpfile tmpfile
+    );
+end
+
+let output_libvirt = new output_libvirt
diff --git a/v2v/target_libvirt.mli b/v2v/output_libvirt.mli
similarity index 80%
rename from v2v/target_libvirt.mli
rename to v2v/output_libvirt.mli
index f7a5669..34c9cee 100644
--- a/v2v/target_libvirt.mli
+++ b/v2v/output_libvirt.mli
@@ -16,8 +16,9 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val initialize : string option -> string -> Types.source -> Types.overlay list -> Types.overlay list
+(** [-o libvirt] target. *)
 
-val create_metadata : string option -> string -> Types.source -> Types.overlay list -> Types.guestcaps -> unit
+val output_libvirt : string option -> string -> Types.output
 
 val create_libvirt_xml : ?pool:string -> Types.source -> Types.overlay list -> Types.guestcaps -> DOM.doc
+(** This is called from {!Output_local} to generate the libvirt XML. *)
diff --git a/v2v/target_local.ml b/v2v/output_local.ml
similarity index 57%
rename from v2v/target_local.ml
rename to v2v/output_local.ml
index 63045e5..e93afee 100644
--- a/v2v/target_local.ml
+++ b/v2v/output_local.ml
@@ -24,19 +24,27 @@ open Common_utils
 open Types
 open Utils
 
-let initialize dir source overlays =
-  List.map (
-    fun ov ->
-      let target_file = dir // source.s_name ^ "-" ^ ov.ov_sd in
-      { ov with ov_target_file = target_file }
-  ) overlays
-
-let create_metadata dir source overlays guestcaps =
-  let doc = Target_libvirt.create_libvirt_xml source overlays guestcaps in
-
-  let name = source.s_name in
-  let file = dir // name ^ ".xml" in
-
-  let chan = open_out file in
-  DOM.doc_to_chan chan doc;
-  close_out chan
+class output_local dir = object
+  inherit output
+
+  method as_options = sprintf "-o local -os %s" dir
+
+  method prepare_output source overlays =
+    List.map (
+      fun ov ->
+        let target_file = dir // source.s_name ^ "-" ^ ov.ov_sd in
+        { ov with ov_target_file = target_file }
+    ) overlays
+
+  method create_metadata source overlays guestcaps _ =
+    let doc = Output_libvirt.create_libvirt_xml source overlays guestcaps in
+
+    let name = source.s_name in
+    let file = dir // name ^ ".xml" in
+
+    let chan = open_out file in
+    DOM.doc_to_chan chan doc;
+    close_out chan
+end
+
+let output_local = new output_local
diff --git a/v2v/convert_linux.mli b/v2v/output_local.mli
similarity index 86%
copy from v2v/convert_linux.mli
copy to v2v/output_local.mli
index f55ce15..fb52676 100644
--- a/v2v/convert_linux.mli
+++ b/v2v/output_local.mli
@@ -16,4 +16,6 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val convert : ?keep_serial_console:bool -> bool -> Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
+(** [-o local] target. *)
+
+val output_local : string -> Types.output
diff --git a/v2v/source_disk.ml b/v2v/source_disk.ml
deleted file mode 100644
index 9bcffbe..0000000
--- a/v2v/source_disk.ml
+++ /dev/null
@@ -1,79 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2014 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.
- *)
-
-open Printf
-
-open Common_gettext.Gettext
-open Common_utils
-
-open Types
-open Utils
-
-let create input_format disk =
-  (* What name should we use for the guest?  We try to derive it from
-   * the filename passed in.  Users can override this using the
-   * `-on name' option.
-   *)
-  let name = Filename.chop_extension (Filename.basename disk) in
-  if name = "" then
-    error (f_"-i disk: invalid input filename (%s)") disk;
-
-  (* Get the absolute path to the disk file. *)
-  let disk_absolute =
-    if not (Filename.is_relative disk) then disk
-    else Sys.getcwd () // disk in
-
-  (* The rest of virt-v2v doesn't actually work unless we detect
-   * the format of the input, so:
-   *)
-  let format =
-    match input_format with
-    | Some format -> format
-    | None ->
-      match (new Guestfs.guestfs ())#disk_format disk with
-      | "unknown" ->
-        error (f_"cannot detect the input disk format; use the -if parameter")
-      | format -> format in
-
-  let disk = {
-    s_qemu_uri = disk_absolute;
-    s_format = Some format;
-    s_target_dev = None;
-  } in
-
-  (* Give the guest a simple generic network interface. *)
-  let network = {
-    s_mac = None;
-    s_vnet = "default";
-    s_vnet_type = Network
-  } in
-
-  let source = {
-    s_dom_type = "kvm";
-    s_name = name; s_orig_name = name;
-    s_memory = 2048L *^ 1024L *^ 1024L; (* 2048 MB *)
-    s_vcpu = 1;                         (* 1 vCPU is a safe default *)
-    s_arch = Config.host_cpu;
-    s_features = [ "acpi"; "apic"; "pae" ];
-    s_display = None;
-    s_disks = [disk];
-    s_removables = [];
-    s_nics = [network];
-  } in
-
-  source
diff --git a/v2v/source_libvirt.ml b/v2v/source_libvirt.ml
deleted file mode 100644
index 6c2e665..0000000
--- a/v2v/source_libvirt.ml
+++ /dev/null
@@ -1,298 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2014 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.
- *)
-
-open Printf
-
-open Common_gettext.Gettext
-open Common_utils
-
-open Types
-open Utils
-
-let identity x = x
-
-let create_xml ?(map_source_file = identity) ?(map_source_dev = identity) xml =
-  let doc = Xml.parse_memory xml in
-  let xpathctx = Xml.xpath_new_context doc in
-
-  let xpath_to_string expr default =
-    let obj = Xml.xpath_eval_expression xpathctx expr in
-    if Xml.xpathobj_nr_nodes obj < 1 then default
-    else (
-      let node = Xml.xpathobj_node doc obj 0 in
-      Xml.node_as_string node
-    )
-  and xpath_to_int expr default =
-    let obj = Xml.xpath_eval_expression xpathctx expr in
-    if Xml.xpathobj_nr_nodes obj < 1 then default
-    else (
-      let node = Xml.xpathobj_node doc obj 0 in
-      let str = Xml.node_as_string node in
-      try int_of_string str
-      with Failure "int_of_string" ->
-        error (f_"expecting XML expression to return an integer (expression: %s)")
-          expr
-    )
-  in
-
-  let dom_type = xpath_to_string "/domain/@type" "" in
-  let name = xpath_to_string "/domain/name/text()" "" in
-  let memory = xpath_to_int "/domain/memory/text()" 0 in
-  let memory = Int64.of_int memory *^ 1024L in
-  let vcpu = xpath_to_int "/domain/vcpu/text()" 0 in
-  let arch = xpath_to_string "/domain/os/type/@arch" "" in
-
-  let features =
-    let features = ref [] in
-    let obj = Xml.xpath_eval_expression xpathctx "/domain/features/*" in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    for i = 0 to nr_nodes-1 do
-      let node = Xml.xpathobj_node doc obj i in
-      features := Xml.node_name node :: !features
-    done;
-    !features in
-
-  let display =
-    let obj = Xml.xpath_eval_expression xpathctx "/domain/devices/graphics" in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    if nr_nodes < 1 then None
-    else (
-      (* Ignore everything except the first <graphics> device. *)
-      let node = Xml.xpathobj_node doc obj 0 in
-      Xml.xpathctx_set_current_context xpathctx node;
-      let keymap =
-        match xpath_to_string "@keymap" "" with "" -> None | k -> Some k in
-      let password =
-        match xpath_to_string "@passwd" "" with "" -> None | pw -> Some pw in
-      match xpath_to_string "@type" "" with
-      | "" -> None
-      | "vnc" ->
-        Some { s_display_type = `VNC;
-               s_keymap = keymap; s_password = password }
-      | "spice" ->
-        Some { s_display_type = `Spice;
-               s_keymap = keymap; s_password = password }
-      | t ->
-        warning ~prog (f_"display <graphics type='%s'> was ignored") t;
-        None
-    ) in
-
-  (* Non-removable disk devices. *)
-  let disks =
-    let get_disks, add_disk =
-      let disks = ref [] in
-      let get_disks () = List.rev !disks in
-      let add_disk qemu_uri format target_dev =
-        disks :=
-          { s_qemu_uri = qemu_uri; s_format = format;
-            s_target_dev = target_dev } :: !disks
-      in
-      get_disks, add_disk
-    in
-    let obj =
-      Xml.xpath_eval_expression xpathctx
-        "/domain/devices/disk[@device='disk']" in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    if nr_nodes < 1 then
-      error (f_"this guest has no non-removable disks");
-    for i = 0 to nr_nodes-1 do
-      let node = Xml.xpathobj_node doc obj i in
-      Xml.xpathctx_set_current_context xpathctx node;
-
-      let target_dev =
-        let target_dev = xpath_to_string "target/@dev" "" in
-        if target_dev <> "" then Some target_dev else None in
-
-      let format =
-        let format = xpath_to_string "driver[@name='qemu']/@type" "" in
-        if format <> "" then Some format else None in
-
-      (* The <disk type='...'> attribute may be 'block', 'file' or
-       * 'network'.  We ignore any other types.
-       *)
-      match xpath_to_string "@type" "" with
-      | "block" ->
-        let path = xpath_to_string "source/@dev" "" in
-        if path <> "" then (
-          let path = map_source_dev path in
-          add_disk path format target_dev
-        )
-      | "file" ->
-        let path = xpath_to_string "source/@file" "" in
-        if path <> "" then (
-          let path = map_source_file path in
-          add_disk path format target_dev
-        )
-      | "network" ->
-        (* We only handle <source protocol="nbd"> here, and that is
-         * intended only for virt-p2v.  Any other network disk is
-         * currently ignored.
-         *)
-        (match xpath_to_string "source/@protocol" "" with
-        | "nbd" ->
-          let host = xpath_to_string "source/host/@name" "" in
-          let port = xpath_to_int "source/host/@port" 0 in
-          if host <> "" && port > 0 then (
-            (* Generate a qemu nbd URL.
-             * XXX Quoting, although it's not needed for virt-p2v.
-             *)
-            let path = sprintf "nbd:%s:%d" host port in
-            add_disk path format target_dev
-          )
-        | "" -> ()
-        | protocol ->
-          warning ~prog (f_"network <disk> with <source protocol='%s'> was ignored")
-            protocol
-        )
-      | disk_type ->
-        warning ~prog (f_"<disk type='%s'> was ignored") disk_type
-    done;
-    get_disks () in
-
-  (* Removable devices, CD-ROMs and floppy disks. *)
-  let removables =
-    let obj =
-      Xml.xpath_eval_expression xpathctx
-        "/domain/devices/disk[@device='cdrom' or @device='floppy']" in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    let disks = ref [] in
-    for i = 0 to nr_nodes-1 do
-      let node = Xml.xpathobj_node doc obj i in
-      Xml.xpathctx_set_current_context xpathctx node;
-
-      let target_dev =
-        let target_dev = xpath_to_string "target/@dev" "" in
-        if target_dev <> "" then Some target_dev else None in
-
-      let typ =
-        match xpath_to_string "@device" "" with
-        | "cdrom" -> `CDROM
-        | "floppy" -> `Floppy
-        | _ -> assert false (* libxml2 error? *) in
-
-      let disk =
-        { s_removable_type = typ; s_removable_target_dev = target_dev } in
-      disks := disk :: !disks
-    done;
-    List.rev !disks in
-
-  (* Network interfaces. *)
-  let nics =
-    let obj = Xml.xpath_eval_expression xpathctx "/domain/devices/interface" in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    let nics = ref [] in
-    for i = 0 to nr_nodes-1 do
-      let node = Xml.xpathobj_node doc obj i in
-      Xml.xpathctx_set_current_context xpathctx node;
-
-      let mac = xpath_to_string "mac/@address" "" in
-      let mac =
-        match mac with
-        | ""
-        | "00:00:00:00:00:00" (* thanks, VMware *) -> None
-        | mac -> Some mac in
-
-      let vnet_type =
-        match xpath_to_string "@type" "" with
-        | "network" -> Some Network
-        | "bridge" -> Some Bridge
-        | _ -> None in
-      match vnet_type with
-      | None -> ()
-      | Some vnet_type ->
-        let vnet = xpath_to_string "source/@network | source/@bridge" "" in
-        if vnet <> "" then (
-          let nic = { s_mac = mac; s_vnet = vnet; s_vnet_type = vnet_type } in
-          nics := nic :: !nics
-        )
-    done;
-    List.rev !nics in
-
-  {
-    s_dom_type = dom_type;
-    s_name = name; s_orig_name = name;
-    s_memory = memory;
-    s_vcpu = vcpu;
-    s_arch = arch;
-    s_features = features;
-    s_display = display;
-    s_disks = disks;
-    s_removables = removables;
-    s_nics = nics;
-  }
-
-(* -i libvirtxml *)
-let create_from_xml file =
-  let xml = read_whole_file file in
-
-  (* When reading libvirt XML from a file (-i libvirtxml) we allow
-   * paths to disk images in the libvirt XML to be relative (to the XML
-   * file).  Relative paths are in fact not permitted in real libvirt
-   * XML, but they are very useful when dealing with test images or
-   * when writing the XML by hand.
-   *)
-  let dir = Filename.dirname (absolute_path file) in
-  let map_source_file path =
-    if not (Filename.is_relative path) then path else dir // path
-  in
-
-  create_xml ~map_source_file xml
-
-(* -i libvirt [-ic libvirt_uri] *)
-let create libvirt_uri guest =
-  (* Depending on the libvirt URI we may need to convert <source/>
-   * paths so we can access them remotely (if that is possible).  This
-   * is only true for remote, non-NULL URIs.  (We assume the user
-   * doesn't try setting $LIBVIRT_URI.  If they do that then all bets
-   * are off).
-   *)
-  let map_source_file, map_source_dev =
-    match libvirt_uri with
-    | None -> None, None
-    | Some orig_uri ->
-      let { Xml.uri_server = server; uri_scheme = scheme } as uri =
-        try Xml.parse_uri orig_uri
-        with Invalid_argument msg ->
-          error (f_"could not parse '-ic %s'.  Original error message was: %s")
-            orig_uri msg in
-      match server, scheme with
-      | None, _
-      | Some "", _ ->                   (* Not a remote URI. *)
-        None, None
-      | Some _, None                    (* No scheme? *)
-      | Some _, Some "" ->
-        None, None
-      | Some _, Some "esx" ->           (* esx://... *)
-        let f = Lib_esx.map_path_to_uri uri in Some f, Some f
-      (* XXX Missing: Look for qemu+ssh://, xen+ssh:// and use an ssh
-       * connection.  This was supported in old virt-v2v.
-       *)
-      | Some _, Some _ ->               (* Unknown remote scheme. *)
-        warning ~prog (f_"no support for remote libvirt connections to '-ic %s'.  The conversion may fail when it tries to read the source disks.")
-          orig_uri;
-        None, None in
-
-  (* Get the libvirt XML. *)
-  let cmd =
-    match libvirt_uri with
-    | None -> sprintf "virsh dumpxml %s" (quote guest)
-    | Some uri -> sprintf "virsh -c %s dumpxml %s" (quote uri) (quote guest) in
-  let lines = external_command ~prog cmd in
-  let xml = String.concat "\n" lines in
-
-  create_xml ?map_source_file ?map_source_dev xml
diff --git a/v2v/target_RHEV.ml b/v2v/target_RHEV.ml
deleted file mode 100644
index 9d2eeb1..0000000
--- a/v2v/target_RHEV.ml
+++ /dev/null
@@ -1,664 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2014 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.
- *)
-
-open Common_gettext.Gettext
-open Common_utils
-
-open Unix
-open Printf
-
-open Types
-open Utils
-open DOM
-
-let title = sprintf "Exported by virt-v2v %s" Config.package_version
-
-(* Describes a mounted Export Storage Domain. *)
-type export_storage_domain = {
-  mp : string;                          (* Local mountpoint. *)
-  uuid : string;                        (* /mp/uuid *)
-}
-
-(* Private data that we keep between calls.  Keep it in a global
- * variables since there's only one conversion going on.
- *)
-(* Export Storage Domain mountpoint. *)
-let esd = ref { mp = ""; uuid = "" }
-(* Target image directory, UUID. *)
-let image_dir = ref ""
-let image_uuid = ref ""
-(* Target VM UUID. *)
-let vm_uuid = ref ""
-(* Flag to indicate if the target image (image_dir) should be
- * deleted.  This is set to false once we know the conversion was
- * successful.
- *)
-let delete_target_directory = ref true
-(* We set the creation time to be the same for all dates in
- * all metadata files.
- *)
-let time = time ()
-let iso_time =
-  let tm = gmtime time in
-  sprintf "%04d/%02d/%02d %02d:%02d:%02d"
-    (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
-    tm.tm_hour tm.tm_min tm.tm_sec
-
-(* This is called early on in the conversion and lets us choose the
- * name of the target files that eventually get written by the main
- * code.
- *
- * 'os' is the output storage (-os nfs:/export).  'source' contains a
- * few useful fields such as the guest name.  'overlays' describes the
- * destination files.  We modify and return this list.
- *
- * Note it's good to fail here (early) if there are any problems, since
- * the next time we are called (in {!create_metadata}) we have already
- * done the conversion and copy, and the user won't thank us for
- * displaying errors there.
- *)
-let rec initialize ~verbose os rhev_params source output_alloc overlays =
-  esd := mount_and_check_export_storage_domain ~verbose os;
-  if verbose then
-    eprintf "RHEV: ESD mountpoint: %s\nRHEV: ESD UUID: %s\n%!" !esd.mp !esd.uuid;
-
-  let overlays =
-    let _image_uuid, _vm_uuid, overlays = create_uuids rhev_params overlays in
-    image_uuid := _image_uuid;
-    vm_uuid := _vm_uuid;
-    overlays in
-
-  (* We need to create the target image directory so there's a place
-   * for the main program to copy the images to.  However if image
-   * conversion fails for any reason then we delete this directory.
-   *)
-  image_dir := !esd.mp // !esd.uuid // "images" // !image_uuid;
-  mkdir !image_dir 0o755;
-  at_exit (fun () ->
-    if !delete_target_directory then (
-      let cmd = sprintf "rm -rf %s" (quote !image_dir) in
-      ignore (Sys.command cmd)
-    )
-  );
-  if verbose then
-    eprintf "RHEV: export directory: %s\n%!" !image_dir;
-
-  (* This loop has two purposes: (1) Generate the randomly named
-   * target files (just the names).  (2) Generate the .meta file
-   * associated with each volume.  At the end we have a directory
-   * structure like this:
-   *   /<MP>/<ESD_UUID>/images/<IMAGE_UUID>/
-   *      <VOL_UUID_1>        # first disk - will be created by main code
-   *      <VOL_UUID_1>.meta   # first disk
-   *      <VOL_UUID_2>        # second disk - will be created by main code
-   *      <VOL_UUID_2>.meta   # second disk
-   *      <VOL_UUID_3>        # etc
-   *      <VOL_UUID_3>.meta   #
-   *)
-  let overlays =
-    let output_alloc_for_rhev =
-      match output_alloc with
-      | `Sparse -> "SPARSE"
-      | `Preallocated -> "PREALLOCATED" in
-
-    List.map (
-      fun ov ->
-        let target_file = !image_dir // ov.ov_vol_uuid in
-
-        if verbose then
-          eprintf "RHEV: will export %s to %s\n%!" ov.ov_sd target_file;
-
-        (* Create the per-volume metadata (.meta files, in an oVirt-
-         * specific format).
-         *)
-        let vol_meta = target_file ^ ".meta" in
-
-        let size_in_sectors =
-          if ov.ov_virtual_size &^ 511L <> 0L then
-            error (f_"the virtual size of the input disk %s is not an exact multiple of 512 bytes.  The virtual size is: %Ld.\n\nThis probably means something unexpected is going on, so please file a bug about this issue.") ov.ov_source_file ov.ov_virtual_size;
-          ov.ov_virtual_size /^ 512L in
-
-        let format_for_rhev =
-          match ov.ov_target_format with
-          | "raw" -> "RAW"
-          | "qcow2" -> "COW"
-          | _ ->
-            error (f_"RHEV does not support the output format '%s', only raw or qcow2") ov.ov_target_format in
-
-        let chan = open_out vol_meta in
-        let fpf fs = fprintf chan fs in
-        fpf "DOMAIN=%s\n" !esd.uuid; (* "Domain" as in Export Storage Domain *)
-        fpf "VOLTYPE=LEAF\n";
-        fpf "CTIME=%.0f\n" time;
-        fpf "MTIME=%.0f\n" time;
-        fpf "IMAGE=%s\n" !image_uuid;
-        fpf "DISKTYPE=1\n";
-        fpf "PUUID=00000000-0000-0000-0000-000000000000\n";
-        fpf "LEGALITY=LEGAL\n";
-        fpf "POOL_UUID=\n";
-        fpf "SIZE=%Ld\n" size_in_sectors;
-        fpf "FORMAT=%s\n" format_for_rhev;
-        fpf "TYPE=%s\n" output_alloc_for_rhev;
-        fpf "DESCRIPTION=%s\n" title;
-        fpf "EOF\n";
-        close_out chan;
-
-        { ov with ov_target_file = target_file }
-    ) overlays in
-
-  (* Return the list of overlays. *)
-  overlays
-
-and mount_and_check_export_storage_domain ~verbose os =
-  (* The user can either specify -os nfs:/export, or a local directory
-   * which is assumed to be the already-mounted NFS export.  In either
-   * case we need to check that we have sufficient permissions to write
-   * to this mountpoint.
-   *)
-  match string_split ":/" os with
-  | mp, "" ->                        (* Already mounted directory. *)
-    check_export_storage_domain os mp
-  | server, export ->
-    let export = "/" ^ export in
-
-    (* Try mounting it. *)
-    let mp = Mkdtemp.temp_dir "v2v." "" in
-    let cmd =
-      sprintf "mount %s:%s %s" (quote server) (quote export) (quote mp) in
-    if verbose then printf "%s\n%!" cmd;
-    if Sys.command cmd <> 0 then
-      error (f_"mount command failed, see earlier errors.\n\nThis probably means you didn't specify the right Export Storage Domain path [-os %s], or else you need to rerun virt-v2v as root.") os;
-
-    (* Make sure it is unmounted at exit. *)
-    at_exit (fun () ->
-      let cmd = sprintf "umount %s" (quote mp) in
-      if verbose then printf "%s\n%!" cmd;
-      ignore (Sys.command cmd);
-      try rmdir mp with _ -> ()
-    );
-
-    check_export_storage_domain os mp
-
-and check_export_storage_domain os mp =
-  (* Typical ESD mountpoint looks like this:
-   * $ ls /tmp/mnt
-   * 39b6af0e-1d64-40c2-97e4-4f094f1919c7  __DIRECT_IO_TEST__  lost+found
-   * $ ls /tmp/mnt/39b6af0e-1d64-40c2-97e4-4f094f1919c7
-   * dom_md  images  master
-   * We expect exactly one of those magic UUIDs.
-   *)
-  let entries =
-    try Sys.readdir mp
-    with Sys_error msg ->
-      error (f_"could not read the Export Storage Domain specified by the '-os %s' parameter on the command line.  Is it really an OVirt or RHEV-M Export Storage Domain?  The original error is: %s") os msg in
-  let entries = Array.to_list entries in
-  let uuids = List.filter (
-    fun entry ->
-      String.length entry = 36 &&
-      entry.[8] = '-' && entry.[13] = '-' && entry.[18] = '-' &&
-      entry.[23] = '-'
-  ) entries in
-  let uuid =
-    match uuids with
-    | [uuid] -> uuid
-    | [] ->
-      error (f_"there are no UUIDs in the Export Storage Domain (%s).  Is it really an OVirt or RHEV-M Export Storage Domain?") os
-    | _::_ ->
-      error (f_"there are multiple UUIDs in the Export Storage Domain (%s).  This is unexpected, and may be a bug in virt-v2v or OVirt.") os in
-
-  (* Check that the domain has been attached to a Data Center by checking that
-   * the master/vms directory exists.
-   *)
-  if not (is_directory (mp // uuid // "master" // "vms")) then
-    error (f_"the Export Storage Domain (%s) has not been attached to any Data Center.\n\nYou have to do this through the RHEV-M / OVirt user interface first.") os;
-
-  (* Check that the ESD is writable. *)
-  let testfile = mp // uuid // "v2v-write-test" in
-  let write_test_failed err =
-    error (f_"the Export Storage Domain (%s) is not writable.\n\nThis probably means you need to run virt-v2v as 'root'.\n\nOriginal error was: %s") os err;
-  in
-  (try
-     let chan = open_out testfile in
-     close_out chan;
-     unlink testfile
-   with
-   | Sys_error err -> write_test_failed err
-   | Unix_error (code, _, _) -> write_test_failed (error_message code)
-  );
-
-  (* Looks good, so return the ESD object. *)
-  { mp = mp; uuid = uuid }
-
-(* Create unique UUIDs for everything, either based on the command
- * line parameters or else we invent them here.
- *)
-and create_uuids rhev_params overlays =
-  let image_uuid =
-    match rhev_params.image_uuid with
-    | Some uuid -> uuid
-    | None -> uuidgen ~prog () in
-  let vm_uuid =
-    match rhev_params.vm_uuid with
-    | Some uuid -> uuid
-    | None -> uuidgen ~prog () in
-
-  (* ... and for volumes. *)
-  let overlays =
-    match rhev_params.vol_uuids with
-    | [] ->
-      List.map (
-        fun ov ->
-          let uuid = uuidgen ~prog () in
-          { ov with ov_vol_uuid = uuid }
-      ) overlays
-    | uuids ->
-      try
-        List.map (
-          fun (ov, uuid) -> { ov with ov_vol_uuid = uuid }
-        ) (List.combine overlays uuids)
-      with Invalid_argument _ ->
-        error (f_"the number of '--rhev-vol-uuid' parameters passed on the command line has to match the number of guest disk images (for this guest: %d)")
-          (List.length overlays) in
-
-  image_uuid, vm_uuid, overlays
-
-(* This is called after conversion to write the OVF metadata. *)
-let rec create_metadata os rhev_params source output_alloc
-    overlays inspect guestcaps =
-  let memsize_mb = source.s_memory /^ 1024L /^ 1024L in
-
-  let vmtype =
-    match rhev_params.vmtype with
-    | Some vmtype -> vmtype
-    | None -> get_vmtype inspect in
-  let vmtype = match vmtype with `Desktop -> "DESKTOP" | `Server -> "SERVER" in
-  let ostype = get_ostype inspect in
-
-  let ovf : doc =
-    doc "ovf:Envelope" [
-      "xmlns:rasd", "http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_ResourceAllocationSettingData";
-      "xmlns:vssd", "http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_VirtualSystemSettingData";
-      "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance";
-      "xmlns:ovf", "http://schemas.dmtf.org/ovf/envelope/1/";
-      "ovf:version", "0.9"
-    ] [
-      e "References" [] [];
-      e "Section" ["xsi:type", "ovf:NetworkSection_Type"] [
-        e "Info" [] [PCData "List of networks"]
-      ];
-      e "Section" ["xsi:type", "ovf:DiskSection_Type"] [
-        e "Info" [] [PCData "List of Virtual Disks"]
-      ];
-      e "Content" ["ovf:id", "out"; "xsi:type", "ovf:VirtualSystem_Type"] [
-        e "Name" [] [PCData source.s_name];
-        e "TemplateId" [] [PCData "00000000-0000-0000-0000-000000000000"];
-        e "TemplateName" [] [PCData "Blank"];
-        e "Description" [] [PCData title];
-        e "Domain" [] [];
-        e "CreationDate" [] [PCData iso_time];
-        e "IsInitilized" [] [PCData "True"];
-        e "IsAutoSuspend" [] [PCData "False"];
-        e "TimeZone" [] [];
-        e "IsStateless" [] [PCData "False"];
-        e "Origin" [] [PCData "0"];
-        e "VmType" [] [PCData vmtype];
-        e "DefaultDisplayType" [] [PCData "1"];
-
-        e "Section" ["ovf:id", !vm_uuid; "ovf:required", "false";
-                     "xsi:type", "ovf:OperatingSystemSection_Type"] [
-          e "Info" [] [PCData "Guest Operating System"];
-          e "Description" [] [PCData ostype];
-        ];
-
-        e "Section" ["xsi:type", "ovf:VirtualHardwareSection_Type"] [
-          e "Info" [] [PCData (sprintf "%d CPU, %Ld Memory" source.s_vcpu memsize_mb)];
-          e "Item" [] [
-            e "rasd:Caption" [] [PCData (sprintf "%d virtual cpu" source.s_vcpu)];
-            e "rasd:Description" [] [PCData "Number of virtual CPU"];
-            e "rasd:InstanceId" [] [PCData "1"];
-            e "rasd:ResourceType" [] [PCData "3"];
-            e "rasd:num_of_sockets" [] [PCData (string_of_int source.s_vcpu)];
-            e "rasd:cpu_per_socket"[] [PCData "1"];
-          ];
-          e "Item" [] [
-            e "rasd:Caption" [] [PCData (sprintf "%Ld MB of memory" memsize_mb)];
-            e "rasd:Description" [] [PCData "Memory Size"];
-            e "rasd:InstanceId" [] [PCData "2"];
-            e "rasd:ResourceType" [] [PCData "4"];
-            e "rasd:AllocationUnits" [] [PCData "MegaBytes"];
-            e "rasd:VirtualQuantity" [] [PCData (Int64.to_string memsize_mb)];
-          ];
-          e "Item" [] [
-            e "rasd:Caption" [] [PCData "USB Controller"];
-            e "rasd:InstanceId" [] [PCData "4"];
-            e "rasd:ResourceType" [] [PCData "23"];
-            e "rasd:UsbPolicy" [] [PCData "Disabled"];
-          ];
-          e "Item" [] [
-            e "rasd:Caption" [] [PCData "Graphical Controller"];
-            e "rasd:InstanceId" [] [PCData "5"];
-            e "rasd:ResourceType" [] [PCData "20"];
-            e "rasd:VirtualQuantity" [] [PCData "1"];
-            e "rasd:Device" [] [PCData "qxl"];
-          ]
-        ]
-      ]
-    ] in
-
-  (* Add disks to the OVF XML. *)
-  add_disks output_alloc overlays guestcaps ovf;
-
-  (* Old virt-v2v ignored removable media. XXX *)
-
-  (* Add networks to the OVF XML. *)
-  add_networks source.s_nics guestcaps ovf;
-
-  (* Old virt-v2v didn't really look at the video and display
-   * metadata, instead just adding a single standard display (see
-   * above).  However it did warn if there was a password on the
-   * display of the old guest.
-   *)
-  (match source with
-  | { s_display = Some { s_password = Some _ } } ->
-    warning ~prog (f_"This guest required a password for connection to its display, but this is not supported by RHEV.  Therefore the converted guest's display will not require a separate password to connect.");
-  | _ -> ());
-
-  (* Write it to the metadata file. *)
-  let dir = !esd.mp // !esd.uuid // "master" // "vms" // !vm_uuid in
-  mkdir dir 0o755;
-  let file = dir // !vm_uuid ^ ".ovf" in
-  let chan = open_out file in
-  doc_to_chan chan ovf;
-  close_out chan;
-
-  (* Finished, so don't delete the target directory on exit. *)
-  delete_target_directory := false
-
-(* Guess vmtype based on the guest inspection data. *)
-and get_vmtype = function
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
-      i_product_name = product }
-      when major >= 5 && string_find product "Server" >= 0 ->
-    `Server
-
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = major }
-      when major >= 5 ->
-    `Desktop
-
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
-      i_product_name = product }
-      when major >= 3 && string_find product "ES" >= 0 ->
-    `Server
-
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = major;
-      i_product_name = product }
-      when major >= 3 && string_find product "AS" >= 0 ->
-    `Server
-
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = major }
-      when major >= 3 ->
-    `Desktop
-
-  | { i_type = "linux"; i_distro = "fedora" } -> `Desktop
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 1 } ->
-    `Desktop                            (* Windows XP *)
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
-      i_product_name = product } when string_find product "XP" >= 0 ->
-    `Desktop                            (* Windows XP *)
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 2 } ->
-    `Server                            (* Windows 2003 *)
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
-      i_product_name = product } when string_find product "Server" >= 0 ->
-    `Server                            (* Windows 2008 *)
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 0 } ->
-    `Desktop                            (* Vista *)
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
-      i_product_name = product } when string_find product "Server" >= 0 ->
-    `Server                             (* Windows 2008R2 *)
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 1 } ->
-    `Server                             (* Windows 7 *)
-
-  | _ -> `Server
-
-and get_ostype = function
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = v;
-      i_arch = "i386" } ->
-    sprintf "RHEL%d" v
-
-  | { i_type = "linux"; i_distro = "rhel"; i_major_version = v;
-      i_arch = "x86_64" } ->
-    sprintf "RHEL%dx64" v
-
-  | { i_type = "linux" } -> "OtherLinux"
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 1 } ->
-    "WindowsXP" (* no architecture differentiation of XP on RHEV *)
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
-      i_product_name = product } when string_find product "XP" >= 0 ->
-    "WindowsXP" (* no architecture differentiation of XP on RHEV *)
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
-      i_arch = "i386" } ->
-    "Windows2003"
-
-  | { i_type = "windows"; i_major_version = 5; i_minor_version = 2;
-      i_arch = "x86_64" } ->
-    "Windows2003x64"
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
-      i_arch = "i386" } ->
-    "Windows2008"
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 0;
-      i_arch = "x86_64" } ->
-    "Windows2008x64"
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
-      i_arch = "i386" } ->
-    "Windows7"
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
-      i_arch = "x86_64"; i_product_variant = "Client" } ->
-    "Windows7x64"
-
-  | { i_type = "windows"; i_major_version = 6; i_minor_version = 1;
-      i_arch = "x86_64" } ->
-    "Windows2008R2x64"
-
-  | { i_type = typ; i_distro = distro;
-      i_major_version = major; i_minor_version = minor;
-      i_product_name = product } ->
-    warning ~prog (f_"unknown guest operating system: %s %s %d.%d (%s)")
-      typ distro major minor product;
-    "Unassigned"
-
-(* This modifies the OVF DOM, adding a section for each disk. *)
-and add_disks output_alloc overlays guestcaps ovf =
-  let references =
-    let nodes = path_to_nodes ovf ["ovf:Envelope"; "References"] in
-    match nodes with
-    | [] | _::_::_ -> assert false
-    | [node] -> node in
-  let disk_section =
-    let sections = path_to_nodes ovf ["ovf:Envelope"; "Section"] in
-    try find_node_by_attr sections ("xsi:type", "ovf:DiskSection_Type")
-    with Not_found -> assert false in
-  let virtualhardware_section =
-    let sections = path_to_nodes ovf ["ovf:Envelope"; "Content"; "Section"] in
-    try find_node_by_attr sections ("xsi:type", "ovf:VirtualHardwareSection_Type")
-    with Not_found -> assert false in
-
-  (* Iterate over the disks, adding them to the OVF document. *)
-  iteri (
-    fun i ov ->
-      let is_boot_drive = i == 0 in
-
-      let vol_uuid = ov.ov_vol_uuid in
-      assert (vol_uuid <> "");
-
-      let fileref = !image_uuid // vol_uuid in
-
-      let size_gb =
-        Int64.to_float ov.ov_virtual_size /. 1024. /. 1024. /. 1024. in
-      let usage_gb =
-        (* In the --no-copy case it can happen that the target file
-         * does not exist.  In that case we simply omit the
-         * ovf:actual_size attribute.
-         *)
-        if Sys.file_exists ov.ov_target_file then (
-          let usage_mb = du_m ov.ov_target_file in
-          if usage_mb > 0L then (
-            let usage_mb = Int64.to_float usage_mb /. 1024. in
-            Some usage_mb
-          ) else None
-        ) else None in
-
-      let format_for_rhev =
-        match ov.ov_target_format with
-        | "raw" -> "RAW"
-        | "qcow2" -> "COW"
-        | _ ->
-          error (f_"RHEV does not support the output format '%s', only raw or qcow2") ov.ov_target_format in
-
-      let output_alloc_for_rhev =
-        match output_alloc with
-        | `Sparse -> "SPARSE"
-        | `Preallocated -> "PREALLOCATED" in
-
-      (* Add disk to <References/> node. *)
-      let disk =
-        e "File" [
-          "ovf:href", fileref;
-          "ovf:id", vol_uuid;
-          "ovf:size", Int64.to_string ov.ov_virtual_size;
-          "ovf:description", title;
-        ] [] in
-      append_child disk references;
-
-      (* Add disk to DiskSection. *)
-      let disk =
-        let attrs = [
-          "ovf:diskId", vol_uuid;
-          "ovf:size", sprintf "%.1f" size_gb;
-          "ovf:fileRef", fileref;
-          "ovf:parentRef", "";
-          "ovf:vm_snapshot_id", uuidgen ~prog ();
-          "ovf:volume-format", format_for_rhev;
-          "ovf:volume-type", output_alloc_for_rhev;
-          "ovf:format", "http://en.wikipedia.org/wiki/Byte"; (* wtf? *)
-          "ovf:disk-interface",
-            if guestcaps.gcaps_block_bus = "virtio" then "VirtIO" else "IDE";
-          "ovf:disk-type", "System"; (* RHBZ#744538 *)
-          "ovf:boot", if is_boot_drive then "True" else "False";
-        ] in
-        let attrs =
-          match usage_gb with
-          | None -> attrs
-          | Some usage_gb ->
-            ("ovf:actual_size", sprintf "%.1f" usage_gb) :: attrs in
-        e "Disk" attrs [] in
-      append_child disk disk_section;
-
-      (* Add disk to VirtualHardware. *)
-      let item =
-        e "Item" [] [
-          e "rasd:InstanceId" [] [PCData vol_uuid];
-          e "rasd:ResourceType" [] [PCData "17"];
-          e "rasd:HostResource" [] [PCData fileref];
-          e "rasd:Parent" [] [PCData "00000000-0000-0000-0000-000000000000"];
-          e "rasd:Template" [] [PCData "00000000-0000-0000-0000-000000000000"];
-          e "rasd:ApplicationList" [] [];
-          e "rasd:StorageId" [] [PCData !esd.uuid];
-          e "rasd:StoragePoolId" [] [PCData "00000000-0000-0000-0000-000000000000"];
-          e "rasd:CreationDate" [] [PCData iso_time];
-          e "rasd:LastModified" [] [PCData iso_time];
-          e "rasd:last_modified_date" [] [PCData iso_time];
-        ] in
-      append_child item virtualhardware_section;
-  ) overlays
-
-and du_m filename =
-  (* There's no OCaml binding for st_blocks, so run coreutils 'du -m'
-   * to get the used size in megabytes.
-   *)
-  let cmd = sprintf "du -m %s | awk '{print $1}'" (quote filename) in
-  let lines = external_command ~prog cmd in
-  (* We really don't want the metadata generation to fail because
-   * of some silly usage information, so ignore errors here.
-   *)
-  match lines with
-  | line::_ -> (try Int64.of_string line with _ -> 0L)
-  | [] -> 0L
-
-(* This modifies the OVF DOM, adding a section for each NIC. *)
-and add_networks nics guestcaps ovf =
-  let network_section =
-    let sections = path_to_nodes ovf ["ovf:Envelope"; "Section"] in
-    try find_node_by_attr sections ("xsi:type", "ovf:NetworkSection_Type")
-    with Not_found -> assert false in
-  let virtualhardware_section =
-    let sections = path_to_nodes ovf ["ovf:Envelope"; "Content"; "Section"] in
-    try find_node_by_attr sections ("xsi:type", "ovf:VirtualHardwareSection_Type")
-    with Not_found -> assert false in
-
-  (* Iterate over the NICs, adding them to the OVF document. *)
-  iteri (
-    fun i { s_mac = mac; s_vnet_type = vnet_type; s_vnet = vnet } ->
-      let dev = sprintf "eth%d" i in
-
-      let model =
-        match guestcaps.gcaps_net_bus with
-        | "rtl8139" -> "1"
-        | "e1000" -> "2"
-        | "virtio" -> "3"
-        | bus ->
-          warning ~prog (f_"unknown NIC model %s for ethernet device %s.  This NIC will be imported as rtl8139 instead.")
-            bus dev;
-          "1" in
-
-      let network = e "Network" ["ovf:name", vnet] [] in
-      append_child network network_section;
-
-      let item =
-        let children = [
-          e "rasd:InstanceId" [] [PCData "3"];
-          e "rasd:Caption" [] [PCData (sprintf "Ethernet adapter on %s" vnet)];
-          e "rasd:ResourceType" [] [PCData "10"];
-          e "rasd:ResourceSubType" [] [PCData model];
-          e "rasd:Connection" [] [PCData vnet];
-          e "rasd:Name" [] [PCData dev];
-        ] in
-        let children =
-          match mac with
-          | None -> children
-          | Some mac -> children @ [e "rasd:MACAddress" [] [PCData mac]] in
-        e "Item" [] children in
-      append_child item virtualhardware_section;
-  ) nics
-
-and append_child child = function
-  | PCData _ -> assert false
-  | Element e -> e.e_children <- e.e_children @ [child]
diff --git a/v2v/target_RHEV.mli b/v2v/target_RHEV.mli
deleted file mode 100644
index b8542ea..0000000
--- a/v2v/target_RHEV.mli
+++ /dev/null
@@ -1,25 +0,0 @@
-(* virt-v2v
- * Copyright (C) 2009-2014 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.
- *)
-
-val initialize : verbose:bool -> string -> Types.output_rhev_params ->
-  Types.source -> [`Sparse | `Preallocated] ->
-  Types.overlay list -> Types.overlay list
-
-val create_metadata : string -> Types.output_rhev_params ->
-  Types.source -> [`Sparse | `Preallocated] -> Types.overlay list ->
-  Types.inspect -> Types.guestcaps -> unit
diff --git a/v2v/types.ml b/v2v/types.ml
index ffc99ce..795ac08 100644
--- a/v2v/types.ml
+++ b/v2v/types.ml
@@ -20,43 +20,6 @@ open Printf
 
 (* Types.  See types.mli for documentation. *)
 
-type input =
-| InputDisk of string option * string
-| InputLibvirt of string option * string
-| InputLibvirtXML of string
-
-type output =
-| OutputLibvirt of string option * string
-| OutputLocal of string
-| OutputRHEV of string * output_rhev_params
-
-and output_rhev_params = {
-  image_uuid : string option;
-  vol_uuids : string list;
-  vm_uuid : string option;
-  vmtype : [`Server|`Desktop] option;
-}
-
-let output_as_options = function
-  | OutputLibvirt (None, os) ->
-    sprintf "-o libvirt -os %s" os
-  | OutputLibvirt (Some uri, os) ->
-    sprintf "-o libvirt -oc %s -os %s" uri os
-  | OutputLocal os ->
-    sprintf "-o local -os %s" os
-  | OutputRHEV (os, params) ->
-    sprintf "-o rhev -os %s%s%s%s%s" os
-      (match params.image_uuid with
-      | None -> "" | Some uuid -> sprintf " --rhev-image-uuid %s" uuid)
-      (String.concat ""
-         (List.map (sprintf " --rhev-vol-uuid %s") params.vol_uuids))
-      (match params.vm_uuid with
-      | None -> "" | Some uuid -> sprintf " --rhev-vm-uuid %s" uuid)
-      (match params.vmtype with
-      | None -> ""
-      | Some `Server -> " --vmtype server"
-      | Some `Desktop -> " --vmtype desktop")
-
 type source = {
   s_dom_type : string;
   s_name : string;
@@ -208,3 +171,21 @@ type guestcaps = {
   gcaps_acpi : bool;
   gcaps_video : string;
 }
+
+type output_rhev_params = {
+  image_uuid : string option;
+  vol_uuids : string list;
+  vm_uuid : string option;
+  vmtype : [`Server|`Desktop] option;
+}
+
+class virtual input = object
+  method virtual source : unit -> source
+end
+
+class virtual output = object
+  method virtual as_options : string
+  method virtual prepare_output : source -> overlay list -> overlay list
+  method virtual create_metadata : source -> overlay list -> guestcaps -> inspect -> unit
+  method keep_serial_console = true
+end
diff --git a/v2v/types.mli b/v2v/types.mli
index 09af68e..b8d867a 100644
--- a/v2v/types.mli
+++ b/v2v/types.mli
@@ -18,29 +18,6 @@
 
 (** Types. *)
 
-type input =
-| InputDisk of string option * string   (* -i disk: format + file name *)
-| InputLibvirt of string option * string (* -i libvirt: -ic + guest name *)
-| InputLibvirtXML of string         (* -i libvirtxml: XML file name *)
-(** The input arguments as specified on the command line. *)
-
-type output =
-| OutputLibvirt of string option * string (* -o libvirt: -oc & -os *)
-| OutputLocal of string             (* -o local: directory *)
-| OutputRHEV of string * output_rhev_params (* -o rhev: output storage *)
-(** The output arguments as specified on the command line. *)
-
-and output_rhev_params = {
-  image_uuid : string option;           (* --rhev-image-uuid *)
-  vol_uuids : string list;              (* --rhev-vol-uuid (multiple) *)
-  vm_uuid : string option;              (* --rhev-vm-uuid *)
-  vmtype : [`Server|`Desktop] option;   (* --vmtype *)
-}
-(** Miscellaneous extra command line parameters used by RHEV. *)
-
-val output_as_options : output -> string
-(** Converts the output struct into the equivalent command line options. *)
-
 type source = {
   s_dom_type : string;                  (** Source domain type, eg "kvm" *)
   s_name : string;                      (** Guest name. *)
@@ -136,3 +113,22 @@ type guestcaps = {
   gcaps_video : string;        (** "qxl", "cirrus" *)
 }
 (** Guest capabilities after conversion.  eg. Was virtio found or installed? *)
+
+class virtual input : object
+  method virtual source : unit -> source
+  (** Examine the source hypervisor and create a source struct. *)
+end
+(** Encapsulates all [-i], etc input arguments as an object. *)
+
+class virtual output : object
+  method virtual as_options : string
+  (** Converts the output object back to the equivalent command line options.
+      This is just used for pretty-printing log messages. *)
+  method virtual prepare_output : source -> overlay list -> overlay list
+  (** Called before conversion to prepare the output. *)
+  method virtual create_metadata : source -> overlay list -> guestcaps -> inspect -> unit
+  (** Called after conversion to finish off and create metadata. *)
+  method keep_serial_console : bool
+  (** Whether this output supports serial consoles (RHEV does not). *)
+end
+(** Encapsulates all [-o], etc output arguments as an object. *)
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 63bc162..a5d4d75 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -39,14 +39,7 @@ let rec main () =
 
   let msg fs = make_message_function ~quiet fs in
 
-  let source =
-    match input with
-    | InputDisk (input_format, disk) ->
-      Source_disk.create input_format disk
-    | InputLibvirt (libvirt_uri, guest) ->
-      Source_libvirt.create libvirt_uri guest
-    | InputLibvirtXML filename ->
-      Source_libvirt.create_from_xml filename in
+  let source = input#source () in
 
   (* Print source and stop. *)
   if print_source then (
@@ -134,7 +127,7 @@ let rec main () =
    * just so we can display errors to the user before doing too much
    * work.
    *)
-  msg (f_"Initializing the target %s") (output_as_options output);
+  msg (f_"Initializing the target %s") output#as_options;
   let overlays =
     initialize_target ~verbose g
       source output output_alloc output_format output_name overlays in
@@ -160,12 +153,9 @@ let rec main () =
       | "sles" | "suse-based" | "opensuse" ->
 
         (* RHEV doesn't support serial console so remove any on conversion. *)
-        let keep_serial_console =
-          match output with
-          | OutputRHEV _ -> Some false
-          | OutputLibvirt _ | OutputLocal _ -> None in
+        let keep_serial_console = output#keep_serial_console in
 
-        Convert_linux.convert ?keep_serial_console
+        Convert_linux.convert ~keep_serial_console
           verbose g inspect source
 
       | distro ->
@@ -234,15 +224,7 @@ let rec main () =
 
   (* Create output metadata. *)
   msg (f_"Creating output metadata");
-  (match output with
-  | OutputLibvirt (oc, os) ->
-    Target_libvirt.create_metadata oc os source overlays guestcaps
-  | OutputLocal dir ->
-    Target_local.create_metadata dir source overlays guestcaps
-  | OutputRHEV (os, rhev_params) ->
-    Target_RHEV.create_metadata os rhev_params source output_alloc
-      overlays inspect guestcaps
-  );
+  output#create_metadata source overlays guestcaps inspect;
 
   msg (f_"Finishing off");
   delete_target_on_exit := false;  (* Don't delete target on exit. *)
@@ -284,14 +266,7 @@ and initialize_target ~verbose g
           ov_source_file = qemu_uri; ov_source_format = backing_format;
           ov_vol_uuid = "" }
     ) overlays in
-  let overlays =
-    match output with
-    | OutputLibvirt (oc, os) ->
-      Target_libvirt.initialize oc os source overlays
-    | OutputLocal dir -> Target_local.initialize dir source overlays
-    | OutputRHEV (os, rhev_params) ->
-      Target_RHEV.initialize ~verbose
-        os rhev_params source output_alloc overlays in
+  let overlays = output#prepare_output source overlays in
   overlays
 
 and inspect_source g root_choice =

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-libvirt/libguestfs.git



More information about the Pkg-libvirt-commits mailing list