Libguestfs - Mar 2017 - [PATCH 2/2] v2v: -i ova: Factor out the OVF parsing into a separate module.

A couple of patches cleaning up the -i ova code.  These are
both just refactoring (or should be at any rate).

The second patch is best viewed with 'git show -w' to exclude
whitespace changes.

Rich.

These functions obscure the true flow of the code, so hoist
them out of the source () method to the top of the file.

No change, just refactoring.
---
 v2v/input_ova.ml | 139 +++++++++++++++++++++++++++----------------------------
 1 file changed, 69 insertions(+), 70 deletions(-)

diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index 72a63d3..9a6a615 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -40,6 +40,69 @@ let libvirt_supports_json_raw_driver ()    else
     true
 
+(* Untar part or all files from tar archive. If [paths] is specified it is
+ * a list of paths in the tar archive.
+ *)
+let untar ?(format = "") ?paths file outdir +  let cmd = [
"tar"; sprintf "-x%sf" format; file; "-C"; outdir
]
+            @ match paths with None -> [] | Some p -> p in
+  if run_command cmd <> 0 then
+    error (f_"error unpacking %s, see earlier error messages") file
+
+(* Untar only ovf and manifest from the archive *)
+let untar_metadata file outdir +  let files = external_command (sprintf
"tar -tf %s" (Filename.quote file)) in
+  let files +    filter_map (
+      fun f ->
+        if Filename.check_suffix f ".ovf" ||
+           Filename.check_suffix f ".mf" then Some f
+        else None
+    ) files in
+  untar ~paths:files file outdir
+
+(* Find files in [dir] ending with [ext]. *)
+let find_files dir ext +  let rec loop = function
+    | [] -> []
+    | dir :: rest ->
+       let files = Array.to_list (Sys.readdir dir) in
+       let files = List.map (Filename.concat dir) files in
+       let dirs, files = List.partition Sys.is_directory files in
+       let files +         List.filter (fun x -> Filename.check_suffix x
ext) files in
+       files @ loop (rest @ dirs)
+  in
+  loop [dir]
+
+(* Uncompress the first few bytes of [file] and return it as
+ * [(bytes, len)].  [zcat] is the command to use (eg. zcat or xzcat).
+ *)
+let uncompress_head zcat file +  let cmd = sprintf "%s %s" zcat
(quote file) in
+  let chan_out, chan_in, chan_err = Unix.open_process_full cmd [||] in
+  let b = Bytes.create 512 in
+  let len = input chan_out b 0 (Bytes.length b) in
+  (* We're expecting the subprocess to fail because we close
+   * the pipe early, so:
+   *)
+  ignore (Unix.close_process_full (chan_out, chan_in, chan_err));
+  b, len
+
+(* Run [detect_file_type] on a compressed file, returning the
+ * type of the uncompressed content (if known).
+ *)
+let uncompressed_type format file +  let zcat = match format with `GZip ->
"zcat" | `XZ -> "xzcat" in
+  let head, headlen = uncompress_head zcat file in
+  let tmpfile, chan +    Filename.open_temp_file "ova.file."
"" in
+  output chan head 0 headlen;
+  close_out chan;
+  let ret = detect_file_type tmpfile in
+  Sys.remove tmpfile;
+  ret
+
 class input_ova ova    let tmpdir      let base_dir = (open_guestfs
())#get_cachedir () in
@@ -52,17 +115,6 @@ object
   method as_options = "-i ova " ^ ova
 
   method source () -    (* Untar part or all files from tar archive. If [paths]
is specified it is
-     * a list of paths in the tar archive.
-     *)
-    let untar ?(format = "") ?paths file outdir -      let cmd -     
[ "tar"; sprintf "-x%sf" format; file; "-C";
outdir ]
-        @ match paths with None -> [] | Some p -> p in
-      if run_command cmd <> 0 then
-        error (f_"error unpacking %s, see earlier error messages")
ova
-    in
-
     (* Extract ova file. *)
     let exploded, partial        (* The spec allows a directory to be specified
as an ova.  This
@@ -70,37 +122,6 @@ object
        *)
       if is_directory ova then ova, false
       else (
-        let uncompress_head zcat file -          let cmd = sprintf "%s
%s" zcat (quote file) in
-          let chan_out, chan_in, chan_err = Unix.open_process_full cmd [||] in
-          let b = Bytes.create 512 in
-          let len = input chan_out b 0 (Bytes.length b) in
-          (* We're expecting the subprocess to fail because we close
-           * the pipe early, so:
-           *)
-          ignore (Unix.close_process_full (chan_out, chan_in, chan_err));
-
-          let tmpfile, chan -            Filename.open_temp_file
~temp_dir:tmpdir "ova.file." "" in
-          output chan b 0 len;
-          close_out chan;
-
-          tmpfile in
-
-        (* Untar only ovf and manifest from the archive *)
-        let untar_metadata ova outdir -          let files -           
external_command (sprintf "tar -tf %s" (Filename.quote ova)) in
-          let files -            filter_map (fun f ->
-              if Filename.check_suffix f ".ovf" ||
-                  Filename.check_suffix f ".mf" then
-                Some f
-              else None
-            ) files in
-          untar ~paths:files ova outdir
-        in
-
         match detect_file_type ova with
         | `Tar ->
           (* Normal ovas are tar file (not compressed). *)
@@ -126,22 +147,17 @@ object
           if run_command cmd <> 0 then
             error (f_"error unpacking %s, see earlier error
messages") ova;
           tmpdir, false
+
         | (`GZip|`XZ) as format ->
-          let zcat, tar_fmt -            match format with
-            | `GZip -> "zcat", "z"
-            | `XZ -> "xzcat", "J" in
-          let tmpfile = uncompress_head zcat ova in
-          let tmpfiletype = detect_file_type tmpfile in
-          (* Remove tmpfile from tmpdir, to leave it empty. *)
-          Sys.remove tmpfile;
-          (match tmpfiletype with
+          (match uncompressed_type format ova with
           | `Tar ->
-            untar ~format:tar_fmt ova tmpdir;
-            tmpdir, false
+             let format = match format with `GZip -> "z" | `XZ
-> "J" in
+             untar ~format ova tmpdir;
+             tmpdir, false
           | `Zip | `GZip | `XZ | `Unknown ->
             error (f_"%s: unsupported file format\n\nFormats which we
currently understand for '-i ova' are: tar (uncompressed, compress with
gzip or xz), zip") ova
           )
+
         | `Unknown ->
           error (f_"%s: unsupported file format\n\nFormats which we
currently understand for '-i ova' are: tar (uncompressed, compress with
gzip or xz), zip") ova
       ) in
@@ -159,23 +175,6 @@ object
       ignore (run_command cmd)
     );
 
-    (* Find files in [dir] ending with [ext]. *)
-    let find_files dir ext -      let rec loop = function
-        | [] -> []
-        | dir :: rest ->
-          let files = Array.to_list (Sys.readdir dir) in
-          let files = List.map (Filename.concat dir) files in
-          let dirs, files = List.partition Sys.is_directory files in
-          let files = List.filter (
-            fun x ->
-              Filename.check_suffix x ext
-          ) files in
-          files @ loop (rest @ dirs)
-      in
-      loop [dir]
-    in
-
     (* Search for the ovf file. *)
     let ovf = find_files exploded ".ovf" in
     let ovf -- 
2.9.3

Mixing the XML parsing with the other functions of this module made it
very hard to understand.  Splitting the XML parsing into another
module simplifies the flow considerably.

This is just code refactoring and should not affect the semantics.
---
 v2v/Makefile.am            |   2 +
 v2v/input_ova.ml           | 323 +++++++++++----------------------------------
 v2v/parse_ovf_from_ova.ml  | 226 +++++++++++++++++++++++++++++++
 v2v/parse_ovf_from_ova.mli |  36 +++++
 4 files changed, 343 insertions(+), 244 deletions(-)
 create mode 100644 v2v/parse_ovf_from_ova.ml
 create mode 100644 v2v/parse_ovf_from_ova.mli

diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index a6a9899..f065654 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -53,6 +53,7 @@ SOURCES_MLI = \
 	output_rhv.mli \
 	output_vdsm.mli \
 	OVF.mli \
+	parse_ovf_from_ova.mli \
 	parse_libvirt_xml.mli \
 	qemu_command.mli \
 	target_bus_assignment.mli \
@@ -73,6 +74,7 @@ SOURCES_ML = \
 	DOM.ml \
 	changeuid.ml \
 	OVF.ml \
+	parse_ovf_from_ova.ml \
 	linux.ml \
 	windows.ml \
 	windows_virtio.ml \
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index 9a6a615..a0a42a7 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -24,7 +24,7 @@ open Unix_utils
 
 open Types
 open Utils
-open Xpath_helpers
+open Parse_ovf_from_ova
 open Name_from_disk
 
 (* Return true if [libvirt] supports ["json:"] pseudo-URLs and
accepts the
@@ -211,262 +211,97 @@ object
                 disk mf mode disk actual mode disk expected;
           )
           else
-            warning (f_"unable to parse line from manifest file: %S")
line
-          ;
+            warning (f_"unable to parse line from manifest file: %S")
line;
           loop ()
         in
         (try loop () with End_of_file -> ());
         close_in chan
     ) mf;
 
-    (* Parse the ovf file. *)
     let ovf_folder = Filename.dirname ovf in
-    let xml = read_whole_file ovf in
-    let doc = Xml.parse_memory xml in
-
-    (* Handle namespaces. *)
-    let xpathctx = Xml.xpath_new_context doc in
-    Xml.xpath_register_ns xpathctx
-      "ovf" "http://schemas.dmtf.org/ovf/envelope/1";
-    Xml.xpath_register_ns xpathctx
-      "rasd"
"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_ResourceAllocationSettingData";
-    Xml.xpath_register_ns xpathctx
-      "vmw" "http://www.vmware.com/schema/ovf";
-    Xml.xpath_register_ns xpathctx
-      "vssd"
"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_VirtualSystemSettingData";
 
-    let xpath_string = xpath_string xpathctx
-    and xpath_int = xpath_int xpathctx
-    and xpath_string_default = xpath_string_default xpathctx
-    and xpath_int_default = xpath_int_default xpathctx
-    and xpath_int64_default = xpath_int64_default xpathctx in
+    (* Parse the ovf file. *)
+    let name, memory, vcpu, firmware, disks, removables, nics +     
parse_ovf_from_ova ovf in
 
-    (* Search for vm name. *)
     let name -      match xpath_string
"/ovf:Envelope/ovf:VirtualSystem/ovf:Name/text()" with
-      | None | Some "" ->
-        warning (f_"could not parse ovf:Name from OVF document");
-        name_from_disk ova
-      | Some name -> name in
-
-    (* Search for memory. *)
-    let memory = xpath_int64_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()"
(1024L *^ 1024L) in
-    let memory = memory *^ 1024L *^ 1024L in
-
-    (* Search for number of vCPUs. *)
-    let vcpu = xpath_int_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()"
1 in
-
-    (* BIOS or EFI firmware? *)
-    let firmware = xpath_string_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value"
"bios" in
-    let firmware -      match firmware with
-      | "bios" -> BIOS
-      | "efi" -> UEFI
-      | s ->
-         error (f_"unknown Config:firmware value %s (expected
\"bios\" or \"efi\")") s in
-
-    (* Helper function to return the parent controller of a disk. *)
-    let parent_controller id -      let expr = sprintf
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:InstanceID/text()=%d]/rasd:ResourceType/text()"
id in
-      let controller = xpath_int expr in
-
-      (* 6: iscsi controller, 5: ide *)
-      match controller with
-      | Some 6 -> Some Source_SCSI
-      | Some 5 -> Some Source_IDE
+      match name with
       | None ->
-        warning (f_"ova disk has no parent controller, please report this
as a bug supplying the *.ovf file extracted from the ova");
-        None
-      | Some controller ->
-        warning (f_"ova disk has an unknown VMware controller type (%d),
please report this as a bug supplying the *.ovf file extracted from the
ova")
-          controller;
-        None
-    in
-
-    (* Hard disks (ResourceType = 17). *)
-    let disks = ref [] in
-    let () -      let expr =
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=17]"
in
-      let obj = Xml.xpath_eval_expression xpathctx expr in
-      let nr_nodes = Xml.xpathobj_nr_nodes obj in
-      for i = 0 to nr_nodes-1 do
-        let n = Xml.xpathobj_node obj i in
-        Xml.xpathctx_set_current_context xpathctx n;
-
-        (* XXX We assume the OVF lists these in order.
-        let address = xpath_int "rasd:AddressOnParent/text()" in
-        *)
-
-        (* Find the parent controller. *)
-        let parent_id = xpath_int "rasd:Parent/text()" in
-        let controller -          match parent_id with
-          | None -> None
-          | Some id -> parent_controller id in
-
-        Xml.xpathctx_set_current_context xpathctx n;
-        let file_id = xpath_string_default "rasd:HostResource/text()"
"" in
-        let rex = Str.regexp "^\\(ovf:\\)?/disk/\\(.*\\)" in
-        if Str.string_match rex file_id 0 then (
-          (* Chase the references through to the actual file name. *)
-          let file_id = Str.matched_group 2 file_id in
-          let expr = sprintf
"/ovf:Envelope/ovf:DiskSection/ovf:Disk[@ovf:diskId='%s']/@ovf:fileRef"
file_id in
-          let file_ref -            match xpath_string expr with
-            | None -> error (f_"error parsing disk fileRef")
-            | Some s -> s in
-          let expr = sprintf
"/ovf:Envelope/ovf:References/ovf:File[@ovf:id='%s']/@ovf:href"
file_ref in
-          let filename -            match xpath_string expr with
-            | None -> error (f_"no href in ovf:File (id=%s)")
file_ref
-            | Some s -> s in
-
-          let expr = sprintf
"/ovf:Envelope/ovf:References/ovf:File[@ovf:id='%s']/@ovf:compression"
file_ref in
-          let compressed -            match xpath_string expr with
-            | None | Some "identity" -> false
-            | Some "gzip" -> true
-            | Some s -> error (f_"unsupported compression in OVF:
%s") s in
-
-          let partial -            if compressed && partial then (
-              (* We cannot access compressed disk inside the tar;
-               * we have to extract it.
-               *)
-              untar ~paths:[(subdirectory exploded ovf_folder) // filename]
-                ova tmpdir;
-              false
-            )
-            else
-              partial in
-
-          let filename -            if partial then
-              (subdirectory exploded ovf_folder) // filename
-            else (
-              (* Does the file exist and is it readable? *)
-              Unix.access (ovf_folder // filename) [Unix.R_OK];
-              ovf_folder // filename
-            ) in
+         warning (f_"could not parse ovf:Name from OVF document");
+         name_from_disk ova
+      | Some name -> name in
 
-          (* The spec allows the file to be gzip-compressed, in which case
-           * we must uncompress it into the tmpdir.
-           *)
-          let filename -            if compressed then (
-              let new_filename = tmpdir // String.random8 () ^
".vmdk" in
-              let cmd -                sprintf "zcat %s > %s"
(quote filename) (quote new_filename) in
-              if shell_command cmd <> 0 then
-                error (f_"error uncompressing %s, see earlier error
messages")
-                  filename;
-              new_filename
-            )
-            else filename in
+    let disks = List.map (
+      fun ({ href = href; compressed = compressed } as disk) ->
+        let partial +          if compressed && partial then (
+            (* We cannot access compressed disk inside the tar;
+             * we have to extract it.
+             *)
+            untar ~paths:[(subdirectory exploded ovf_folder) // href]
+                  ova tmpdir;
+            false
+          )
+          else
+            partial in
+
+        let filename +          if partial then
+            (subdirectory exploded ovf_folder) // href
+          else (
+            (* Does the file exist and is it readable? *)
+            Unix.access (ovf_folder // href) [Unix.R_OK];
+            ovf_folder // href
+          ) in
+
+        (* The spec allows the file to be gzip-compressed, in which case
+         * we must uncompress it into the tmpdir.
+         *)
+        let filename +          if compressed then (
+            let new_filename = tmpdir // String.random8 () ^ ".vmdk"
in
+            let cmd +              sprintf "zcat %s > %s" (quote
filename) (quote new_filename) in
+            if shell_command cmd <> 0 then
+              error (f_"error uncompressing %s, see earlier error
messages")
+                    filename;
+            new_filename
+          )
+          else filename in
 
-          let qemu_uri -            if not partial then (
-              filename
-            )
-            else (
-              let offset, size -                try find_file_in_tar ova
filename
-                with
-                | Not_found ->
-                  error (f_"file '%s' not found in the ova")
filename
-                | Failure msg -> error (f_"%s") msg in
-              (* QEMU requires size aligned to 512 bytes. This is safe because
-               * tar also works with 512 byte blocks.
-               *)
-              let size = roundup64 size 512L in
-              let doc = [
+        let qemu_uri +          if not partial then (
+            filename
+          )
+          else (
+            let offset, size +              try find_file_in_tar ova filename
+              with
+              | Not_found ->
+                 error (f_"file '%s' not found in the ova")
filename
+              | Failure msg -> error (f_"%s") msg in
+            (* QEMU requires size aligned to 512 bytes. This is safe because
+             * tar also works with 512 byte blocks.
+             *)
+            let size = roundup64 size 512L in
+            let doc = [
                 "file", JSON.Dict [
-                  "driver", JSON.String "raw";
-                  "offset", JSON.Int64 offset;
-                  "size", JSON.Int64 size;
-                  "file", JSON.Dict [
-                    "driver", JSON.String "file";
-                    "filename", JSON.String ova]
-                  ]
-                ] in
-              let uri -                sprintf "json:%s"
(JSON.string_of_doc ~fmt:JSON.Compact doc) in
-              debug "json: %s" uri;
-              uri
-            ) in
-
-          let disk = {
-            s_disk_id = i;
-            s_qemu_uri = qemu_uri;
-            s_format = Some "vmdk";
-            s_controller = controller;
-          } in
-          push_front disk disks;
-        ) else
-          error (f_"could not parse disk rasd:HostResource from OVF
document")
-      done in
-    let disks = List.rev !disks in
-
-    (* Floppies (ResourceType = 14), CDs (ResourceType = 15) and
-     * CDROMs (ResourceType = 16).  (What is the difference?)  Try hard
-     * to preserve the original ordering from the OVF.
-     *)
-    let removables = ref [] in
-    let () -      let expr -       
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=14
or rasd:ResourceType/text()=15 or rasd:ResourceType/text()=16]" in
-      let obj = Xml.xpath_eval_expression xpathctx expr in
-      let nr_nodes = Xml.xpathobj_nr_nodes obj in
-      for i = 0 to nr_nodes-1 do
-        let n = Xml.xpathobj_node obj i in
-        Xml.xpathctx_set_current_context xpathctx n;
-        let id -          match xpath_int "rasd:ResourceType/text()"
with
-          | None -> assert false
-          | Some (14|15|16 as i) -> i
-          | Some _ -> assert false in
-
-        let slot = xpath_int "rasd:AddressOnParent/text()" in
-
-        (* Find the parent controller. *)
-        let parent_id = xpath_int "rasd:Parent/text()" in
-        let controller -          match parent_id with
-          | None -> None
-          | Some id -> parent_controller id in
-
-        let typ -          match id with
-            | 14 -> Floppy
-            | 15 | 16 -> CDROM
-            | _ -> assert false in
-        let disk = {
-          s_removable_type = typ;
-          s_removable_controller = controller;
-          s_removable_slot = slot;
-        } in
-        push_front disk removables;
-      done in
-    let removables = List.rev !removables in
-
-    (* Search for networks ResourceType: 10 *)
-    let nics = ref [] in
-    let obj = Xml.xpath_eval_expression xpathctx
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=10]"
in
-    let nr_nodes = Xml.xpathobj_nr_nodes obj in
-    for i = 0 to nr_nodes-1 do
-      let n = Xml.xpathobj_node obj i in
-      Xml.xpathctx_set_current_context xpathctx n;
-      let vnet -        xpath_string_default
"rasd:ElementName/text()" (sprintf"eth%d" i) in
-      let nic = {
-        s_mac = None;
-        s_nic_model = None;
-        s_vnet = vnet;
-        s_vnet_orig = vnet;
-        s_vnet_type = Network;
-      } in
-      push_front nic nics
-    done;
+                            "driver", JSON.String "raw";
+                            "offset", JSON.Int64 offset;
+                            "size", JSON.Int64 size;
+                            "file", JSON.Dict [
+                                        "driver", JSON.String
"file";
+                                        "filename", JSON.String ova]
+                          ]
+              ] in
+            let uri +              sprintf "json:%s"
(JSON.string_of_doc ~fmt:JSON.Compact doc) in
+            debug "json: %s" uri;
+            uri
+          ) in
+
+        { disk.source_disk with s_qemu_uri = qemu_uri }
+     ) disks in
 
     let source = {
       s_hypervisor = VMware;
@@ -481,7 +316,7 @@ object
       s_sound = None;
       s_disks = disks;
       s_removables = removables;
-      s_nics = List.rev !nics;
+      s_nics = nics;
     } in
 
     source
diff --git a/v2v/parse_ovf_from_ova.ml b/v2v/parse_ovf_from_ova.ml
new file mode 100644
index 0000000..989483e
--- /dev/null
+++ b/v2v/parse_ovf_from_ova.ml
@@ -0,0 +1,226 @@
+(* virt-v2v
+ * Copyright (C) 2009-2017 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.
+ *)
+
+(* Parse OVF from an externally produced OVA file. *)
+
+open Common_gettext.Gettext
+open Common_utils
+open Unix_utils
+
+open Types
+open Utils
+open Xpath_helpers
+
+open Printf
+
+type ovf_disk = {
+  source_disk : Types.source_disk;
+  href : string;                (* The <File href> from the OVF file. *)
+  compressed : bool;            (* If the file is gzip compressed. *)
+}
+
+let parse_ovf_from_ova ovf_filename +  let xml = read_whole_file ovf_filename
in
+  let doc = Xml.parse_memory xml in
+
+  (* Handle namespaces. *)
+  let xpathctx = Xml.xpath_new_context doc in
+  Xml.xpath_register_ns xpathctx
+                        "ovf"
"http://schemas.dmtf.org/ovf/envelope/1";
+  Xml.xpath_register_ns xpathctx
+                        "rasd"
"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_ResourceAllocationSettingData";
+  Xml.xpath_register_ns xpathctx
+                        "vmw"
"http://www.vmware.com/schema/ovf";
+  Xml.xpath_register_ns xpathctx
+                        "vssd"
"http://schemas.dmtf.org/wbem/wscim/1/cim-schema/2/CIM_VirtualSystemSettingData";
+
+  let xpath_string = xpath_string xpathctx
+  and xpath_int = xpath_int xpathctx
+  and xpath_string_default = xpath_string_default xpathctx
+  and xpath_int_default = xpath_int_default xpathctx
+  and xpath_int64_default = xpath_int64_default xpathctx in
+
+  let rec parse_top () +    (* Search for vm name. *)
+    let name +      match xpath_string
"/ovf:Envelope/ovf:VirtualSystem/ovf:Name/text()" with
+      | None | Some "" -> None
+      | Some _ as name -> name in
+
+    (* Search for memory. *)
+    let memory = xpath_int64_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()"
(1024L *^ 1024L) in
+    let memory = memory *^ 1024L *^ 1024L in
+
+    (* Search for number of vCPUs. *)
+    let vcpu = xpath_int_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()"
1 in
+
+    (* BIOS or EFI firmware? *)
+    let firmware = xpath_string_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value"
"bios" in
+    let firmware +      match firmware with
+      | "bios" -> BIOS
+      | "efi" -> UEFI
+      | s ->
+         error (f_"unknown Config:firmware value %s (expected
\"bios\" or \"efi\")") s in
+
+    name, memory, vcpu, firmware,
+    parse_disks (), parse_removables (), parse_nics ()
+
+  (* Helper function to return the parent controller of a disk. *)
+  and parent_controller id +    let expr = sprintf
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:InstanceID/text()=%d]/rasd:ResourceType/text()"
id in
+    let controller = xpath_int expr in
+
+    (* 6: iscsi controller, 5: ide *)
+    match controller with
+    | Some 6 -> Some Source_SCSI
+    | Some 5 -> Some Source_IDE
+    | None ->
+       warning (f_"ova disk has no parent controller, please report this
as a bug supplying the *.ovf file extracted from the ova");
+       None
+    | Some controller ->
+       warning (f_"ova disk has an unknown VMware controller type (%d),
please report this as a bug supplying the *.ovf file extracted from the
ova")
+               controller;
+       None
+
+  (* Hard disks (ResourceType = 17). *)
+  and parse_disks () +    let disks = ref [] in
+    let expr =
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=17]"
in
+    let obj = Xml.xpath_eval_expression xpathctx expr in
+    let nr_nodes = Xml.xpathobj_nr_nodes obj in
+    for i = 0 to nr_nodes-1 do
+      let n = Xml.xpathobj_node obj i in
+      Xml.xpathctx_set_current_context xpathctx n;
+
+      (* XXX We assume the OVF lists these in order.
+         let address = xpath_int "rasd:AddressOnParent/text()" in
+       *)
+
+      (* Find the parent controller. *)
+      let parent_id = xpath_int "rasd:Parent/text()" in
+      let controller +        match parent_id with
+        | None -> None
+        | Some id -> parent_controller id in
+
+      Xml.xpathctx_set_current_context xpathctx n;
+      let file_id = xpath_string_default "rasd:HostResource/text()"
"" in
+      let rex = Str.regexp "^\\(ovf:\\)?/disk/\\(.*\\)" in
+      if Str.string_match rex file_id 0 then (
+        (* Chase the references through to the actual file name. *)
+        let file_id = Str.matched_group 2 file_id in
+        let expr = sprintf
"/ovf:Envelope/ovf:DiskSection/ovf:Disk[@ovf:diskId='%s']/@ovf:fileRef"
file_id in
+        let file_ref +          match xpath_string expr with
+          | None -> error (f_"error parsing disk fileRef")
+          | Some s -> s in
+        let expr = sprintf
"/ovf:Envelope/ovf:References/ovf:File[@ovf:id='%s']/@ovf:href"
file_ref in
+        let href +          match xpath_string expr with
+          | None -> error (f_"no href in ovf:File (id=%s)")
file_ref
+          | Some s -> s in
+
+        let expr = sprintf
"/ovf:Envelope/ovf:References/ovf:File[@ovf:id='%s']/@ovf:compression"
file_ref in
+        let compressed +          match xpath_string expr with
+          | None | Some "identity" -> false
+          | Some "gzip" -> true
+          | Some s -> error (f_"unsupported compression in OVF:
%s") s in
+
+        let disk = {
+          source_disk = {
+            s_disk_id = i;
+            s_qemu_uri = "";
+            s_format = Some "vmdk";
+            s_controller = controller;
+          };
+          href = href;
+          compressed = compressed
+        } in
+        push_front disk disks;
+      ) else
+        error (f_"could not parse disk rasd:HostResource from OVF
document")
+    done;
+    List.rev !disks
+
+  (* Floppies (ResourceType = 14), CDs (ResourceType = 15) and
+   * CDROMs (ResourceType = 16).  (What is the difference?)  Try hard
+   * to preserve the original ordering from the OVF.
+   *)
+  and parse_removables () +    let removables = ref [] in
+    let expr =
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=14
or rasd:ResourceType/text()=15 or rasd:ResourceType/text()=16]" in
+    let obj = Xml.xpath_eval_expression xpathctx expr in
+    let nr_nodes = Xml.xpathobj_nr_nodes obj in
+    for i = 0 to nr_nodes-1 do
+      let n = Xml.xpathobj_node obj i in
+      Xml.xpathctx_set_current_context xpathctx n;
+      let id +        match xpath_int "rasd:ResourceType/text()" with
+        | None -> assert false
+        | Some (14|15|16 as i) -> i
+        | Some _ -> assert false in
+
+      let slot = xpath_int "rasd:AddressOnParent/text()" in
+
+      (* Find the parent controller. *)
+      let parent_id = xpath_int "rasd:Parent/text()" in
+      let controller +        match parent_id with
+        | None -> None
+        | Some id -> parent_controller id in
+
+      let typ +        match id with
+        | 14 -> Floppy
+        | 15 | 16 -> CDROM
+        | _ -> assert false in
+      let disk = {
+        s_removable_type = typ;
+        s_removable_controller = controller;
+        s_removable_slot = slot;
+      } in
+      push_front disk removables;
+    done;
+    List.rev !removables
+
+  (* Search for networks ResourceType: 10 *)
+  and parse_nics () +    let nics = ref [] in
+    let expr =
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=10]"
in
+    let obj = Xml.xpath_eval_expression xpathctx expr in
+    let nr_nodes = Xml.xpathobj_nr_nodes obj in
+    for i = 0 to nr_nodes-1 do
+      let n = Xml.xpathobj_node obj i in
+      Xml.xpathctx_set_current_context xpathctx n;
+      let vnet +        xpath_string_default
"rasd:ElementName/text()" (sprintf"eth%d" i) in
+      let nic = {
+        s_mac = None;
+        s_nic_model = None;
+        s_vnet = vnet;
+        s_vnet_orig = vnet;
+        s_vnet_type = Network;
+      } in
+      push_front nic nics
+    done;
+    List.rev !nics
+  in
+
+  parse_top ()
diff --git a/v2v/parse_ovf_from_ova.mli b/v2v/parse_ovf_from_ova.mli
new file mode 100644
index 0000000..3f60abc
--- /dev/null
+++ b/v2v/parse_ovf_from_ova.mli
@@ -0,0 +1,36 @@
+(* virt-v2v
+ * Copyright (C) 2009-2017 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.
+ *)
+
+(** Parse OVF from an externally produced OVA file.
+
+    This is used by [-i ova] only.  OVA files are not a real standard
+    so we must make some assumptions here, eg. about disk format
+    being VMDK, which would not be true for oVirt. *)
+
+type ovf_disk = {
+  source_disk : Types.source_disk;
+  href : string;                (** The <File href> from the OVF file. *)
+  compressed : bool;            (** If the href is gzip compressed. *)
+}
+(** A VMDK disk from a parsed OVF. *)
+
+val parse_ovf_from_ova : string -> string option * int64 * int *
Types.source_firmware * ovf_disk list * Types.source_removable list *
Types.source_nic list
+(** Parse an OVF file.
+
+    The returned tuple is
+    [name, memory, vcpu, firmware, disks, removables, nics] *)
-- 
2.9.3

In data lunedì 13 marzo 2017 13:14:52 CET, Richard W.M. Jones ha
scritto:
> Mixing the XML parsing with the other functions of this module made it
> very hard to understand.  Splitting the XML parsing into another
> module simplifies the flow considerably.
> 
> This is just code refactoring and should not affect the semantics.
> ---
Mostly LGTM, just one note:
> +                            "driver", JSON.String
"raw";
> +                            "offset", JSON.Int64 offset;
> +                            "size", JSON.Int64 size;
> +                            "file", JSON.Dict [
> +                                        "driver", JSON.String
"file";
> +                                        "filename", JSON.String
ova]
> +                          ]
> +              ] in
The indentation of this block seems weird.

Thanks,
-- 
Pino Toscano

In data lunedì 13 marzo 2017 13:14:51 CET, Richard W.M. Jones ha
scritto:
> These functions obscure the true flow of the code, so hoist
> them out of the source () method to the top of the file.
> 
> No change, just refactoring.
> ---
LGTM.

Thanks,
-- 
Pino Toscano