From e43fe85f28ba6fb184e6894db019668f0515c38d Mon Sep 17 00:00:00 2001

From: "Richard W.M. Jones" <rjones@redhat.com>

Date: Mon, 10 Apr 2017 15:24:26 +0100

Subject: [PATCH] v2v: Implement -i vmx to read VMware vmx files directly

 (RHBZ#1441197).

This is a mostly complete implementation of a VMX parser and input

class for virt-v2v.  It parses the name, memory size, CPU topology,

firmware, video, sound, hard disks, removable disks and network

interfaces from the VMX file.  It only omits support for floppies and

SCSI CD-ROMs.

The input class is split into two major parts: a generic VMX file

parser (Parse_vmx), and the Input_vmx module which translates the VMX

tree into the source device model.

This also contains tests.  There are simple unit tests of the

Parse_vmx module, and also some more complete parsing tests taken from

real guests.

(cherry picked from commit ca40078cdda9167d4658ddfe24c828c7ee76be37)

---

 v2v/Makefile.am               |  15 ++

 v2v/cmdline.ml                |  12 +-

 v2v/input_vmx.ml              | 349 ++++++++++++++++++++++++++++++++++++++

 v2v/input_vmx.mli             |  22 +++

 v2v/name_from_disk.ml         |   2 +-

 v2v/parse_vmx.ml              | 381 ++++++++++++++++++++++++++++++++++++++++++

 v2v/parse_vmx.mli             |  89 ++++++++++

 v2v/test-v2v-i-vmx-1.expected |  39 +++++

 v2v/test-v2v-i-vmx-1.vmx      | 172 +++++++++++++++++++

 v2v/test-v2v-i-vmx-2.expected |  19 +++

 v2v/test-v2v-i-vmx-2.vmx      |  84 ++++++++++

 v2v/test-v2v-i-vmx-3.expected |  19 +++

 v2v/test-v2v-i-vmx-3.vmx      |  91 ++++++++++

 v2v/test-v2v-i-vmx-4.expected |  19 +++

 v2v/test-v2v-i-vmx-4.vmx      |  88 ++++++++++

 v2v/test-v2v-i-vmx.sh         |  48 ++++++

 v2v/v2v_unit_tests.ml         | 143 ++++++++++++++++

 v2v/virt-v2v.pod              |  72 +++++++-

 18 files changed, 1655 insertions(+), 9 deletions(-)

 create mode 100644 v2v/input_vmx.ml

 create mode 100644 v2v/input_vmx.mli

 create mode 100644 v2v/parse_vmx.ml

 create mode 100644 v2v/parse_vmx.mli

 create mode 100644 v2v/test-v2v-i-vmx-1.expected

 create mode 100644 v2v/test-v2v-i-vmx-1.vmx

 create mode 100644 v2v/test-v2v-i-vmx-2.expected

 create mode 100644 v2v/test-v2v-i-vmx-2.vmx

 create mode 100644 v2v/test-v2v-i-vmx-3.expected

 create mode 100644 v2v/test-v2v-i-vmx-3.vmx

 create mode 100644 v2v/test-v2v-i-vmx-4.expected

 create mode 100644 v2v/test-v2v-i-vmx-4.vmx

 create mode 100755 v2v/test-v2v-i-vmx.sh

diff --git a/v2v/Makefile.am b/v2v/Makefile.am

index 297406496..0df759eca 100644

--- a/v2v/Makefile.am

+++ b/v2v/Makefile.am

@@ -38,6 +38,7 @@ SOURCES_MLI = \

 	input_libvirt_xen_ssh.mli \

 	input_libvirtxml.mli \

 	input_ova.mli \

+	input_vmx.mli \

 	inspect_source.mli \

 	libvirt_utils.mli \

 	linux.mli \

@@ -55,6 +56,7 @@ SOURCES_MLI = \

 	OVF.mli \

 	parse_ovf_from_ova.mli \

 	parse_libvirt_xml.mli \

+	parse_vmx.mli \

 	qemu_command.mli \

 	target_bus_assignment.mli \

 	types.mli \

@@ -80,6 +82,7 @@ SOURCES_ML = \

 	windows_virtio.ml \

 	modules_list.ml \

 	input_disk.ml \

+	parse_vmx.ml \

 	parse_libvirt_xml.ml \

 	create_libvirt_xml.ml \

 	qemu_command.ml \

@@ -89,6 +92,7 @@ SOURCES_ML = \

 	input_libvirt_xen_ssh.ml \

 	input_libvirt.ml \

 	input_ova.ml \

+	input_vmx.ml \

 	linux_bootloaders.ml \

 	linux_kernels.ml \

 	convert_linux.ml \

@@ -268,6 +272,7 @@ TESTS = \

 	test-v2v-i-ova-subfolders.sh \

 	test-v2v-i-ova-tar.sh \

 	test-v2v-i-ova-two-disks.sh \

+	test-v2v-i-vmx.sh \

 	test-v2v-bad-networks-and-bridges.sh

 if HAVE_LIBVIRT

@@ -411,6 +416,15 @@ EXTRA_DIST += \

 	test-v2v-i-ova.ovf \

 	test-v2v-i-ova.sh \

 	test-v2v-i-ova.xml \

+	test-v2v-i-vmx.sh \

+	test-v2v-i-vmx-1.expected \

+	test-v2v-i-vmx-2.expected \

+	test-v2v-i-vmx-3.expected \

+	test-v2v-i-vmx-4.expected \

+	test-v2v-i-vmx-1.vmx \

+	test-v2v-i-vmx-2.vmx \

+	test-v2v-i-vmx-3.vmx \

+	test-v2v-i-vmx-4.vmx \

 	test-v2v-machine-readable.sh \

 	test-v2v-networks-and-bridges-expected.xml \

 	test-v2v-networks-and-bridges.sh \

@@ -450,6 +464,7 @@ v2v_unit_tests_BOBJECTS = \

 	windows.cmo \

 	windows_virtio.cmo \

 	linux.cmo \

+	parse_vmx.cmo \

 	v2v_unit_tests.cmo

 v2v_unit_tests_XOBJECTS = $(v2v_unit_tests_BOBJECTS:.cmo=.cmx)

diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml

index 3e3d5c312..db2346a38 100644

--- a/v2v/cmdline.ml

+++ b/v2v/cmdline.ml

@@ -86,6 +86,7 @@ let parse_cmdline () =

     | "libvirt" -> input_mode := `Libvirt

     | "libvirtxml" -> input_mode := `LibvirtXML

     | "ova" -> input_mode := `OVA

+    | "vmx" -> input_mode := `VMX

     | s ->

       error (f_"unknown -i option: %s") s

   in

@@ -333,7 +334,16 @@ read the man page virt-v2v(1).

         | [filename] -> filename

         | _ ->

           error (f_"expecting an OVA file name on the command line") in

-      Input_ova.input_ova filename in

+      Input_ova.input_ova filename

+

+    | `VMX ->

+      (* -i vmx: Expecting an vmx filename. *)

+      let filename =

+        match args with

+        | [filename] -> filename

+        | _ ->

+          error (f_"expecting a VMX file name on the command line") in

+      Input_vmx.input_vmx filename in

   (* Prevent use of --in-place option in RHEL. *)

   if in_place then

diff --git a/v2v/input_vmx.ml b/v2v/input_vmx.ml

new file mode 100644

index 000000000..bb09f0bf8

--- /dev/null

+++ b/v2v/input_vmx.ml

@@ -0,0 +1,349 @@

+(* virt-v2v

+ * Copyright (C) 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.

+ *)

+

+open Printf

+open Scanf

+

+open Common_gettext.Gettext

+open Common_utils

+

+open Types

+open Utils

+open Name_from_disk

+

+external identity : 'a -> 'a = "%identity"

+

+let rec find_disks vmx vmx_filename =

+  find_scsi_disks vmx vmx_filename @ find_ide_disks vmx vmx_filename

+

+(* Find all SCSI hard disks.

+ *

+ * In the VMX file:

+ *   scsi0.virtualDev = "pvscsi"  # or may be "lsilogic" etc.

+ *   scsi0:0.deviceType = "scsi-hardDisk"

+ *   scsi0:0.fileName = "guest.vmdk"

+ *)

+and find_scsi_disks vmx vmx_filename =

+  let get_scsi_controller_target ns =

+    sscanf ns "scsi%d:%d" (fun c t -> c, t)

+  in

+  let is_scsi_controller_target ns =

+    try ignore (get_scsi_controller_target ns); true

+    with Scanf.Scan_failure _ | End_of_file | Failure _ -> false

+  in

+  let scsi_device_types = [ "scsi-harddisk" ] in

+  let scsi_controller = Source_SCSI in

+

+  find_hdds vmx vmx_filename

+            get_scsi_controller_target is_scsi_controller_target

+            scsi_device_types scsi_controller

+

+(* Find all IDE hard disks.

+ *

+ * In the VMX file:

+ *   ide0:0.deviceType = "ata-hardDisk"

+ *   ide0:0.fileName = "guest.vmdk"

+ *)

+and find_ide_disks vmx vmx_filename =

+  let get_ide_controller_target ns =

+    sscanf ns "ide%d:%d" (fun c t -> c, t)

+  in

+  let is_ide_controller_target ns =

+    try ignore (get_ide_controller_target ns); true

+    with Scanf.Scan_failure _ | End_of_file | Failure _ -> false

+  in

+  let ide_device_types = [ "ata-harddisk" ] in

+  let ide_controller = Source_IDE in

+

+  find_hdds vmx vmx_filename

+            get_ide_controller_target is_ide_controller_target

+            ide_device_types ide_controller

+

+and find_hdds vmx vmx_filename

+              get_controller_target is_controller_target

+              device_types controller =

+  (* Find namespaces matching '(ide|scsi)X:Y' with suitable deviceType. *)

+  let hdds =

+    Parse_vmx.select_namespaces (

+      function

+      | [ns] ->

+         (* Check the namespace is '(ide|scsi)X:Y' *)

+         if not (is_controller_target ns) then false

+         else (

+           (* Check the deviceType is one we are looking for. *)

+           match Parse_vmx.get_string vmx [ns; "deviceType"] with

+           | Some str ->

+              let str = String.lowercase_ascii str in

+              List.mem str device_types

+           | None -> false

+         )

+      | _ -> false

+    ) vmx in

+

+  (* Map the subset to a list of disks. *)

+  let hdds =

+    Parse_vmx.map (

+      fun path v ->

+        match path, v with

+        | [ns; "filename"], Some filename ->

+           let c, t = get_controller_target ns in

+           let s = { s_disk_id = (-1);

+                     s_qemu_uri = qemu_uri_of_filename vmx_filename filename;

+                     s_format = Some "vmdk";

+                     s_controller = Some controller } in

+           Some (c, t, s)

+        | _ -> None

+    ) hdds in

+  let hdds = filter_map identity hdds in

+

+  (* We don't have a way to return the controllers and targets, so

+   * just make sure the disks are sorted into order, since Parse_vmx

+   * won't return them in any particular order.

+   *)

+  let hdds = List.sort compare hdds in

+  let hdds = List.map (fun (_, _, source) -> source) hdds in

+

+  (* Set the s_disk_id field to an incrementing number. *)

+  let hdds = mapi (fun i source -> { source with s_disk_id = i }) hdds in

+

+  hdds

+

+(* The filename can be an absolute path, but is more often a

+ * path relative to the location of the vmx file.

+ *

+ * Note that we always end up with an absolute path, which is

+ * also useful because it means we won't have any paths that

+ * could be misinterpreted by qemu.

+ *)

+and qemu_uri_of_filename vmx_filename filename =

+  if not (Filename.is_relative filename) then

+    filename

+  else (

+    let dir = Filename.dirname (absolute_path vmx_filename) in

+    dir // filename

+  )

+

+(* Find all removable disks.

+ *

+ * In the VMX file:

+ *   ide1:0.deviceType = "cdrom-image"

+ *   ide1:0.fileName = "boot.iso"

+ *

+ * XXX This only supports IDE CD-ROMs, but we could support SCSI

+ * CD-ROMs and floppies in future.

+ *)

+and find_removables vmx =

+  let get_ide_controller_target ns =

+    sscanf ns "ide%d:%d" (fun c t -> c, t)

+  in

+  let is_ide_controller_target ns =

+    try ignore (get_ide_controller_target ns); true

+    with Scanf.Scan_failure _ | End_of_file | Failure _ -> false

+  in

+  let device_types = [ "atapi-cdrom";

+                       "cdrom-image"; "cdrom-raw" ] in

+

+  (* Find namespaces matching 'ideX:Y' with suitable deviceType. *)

+  let devs =

+    Parse_vmx.select_namespaces (

+      function

+      | [ns] ->

+         (* Check the namespace is 'ideX:Y' *)

+         if not (is_ide_controller_target ns) then false

+         else (

+           (* Check the deviceType is one we are looking for. *)

+           match Parse_vmx.get_string vmx [ns; "deviceType"] with

+           | Some str ->

+              let str = String.lowercase_ascii str in

+              List.mem str device_types

+           | None -> false

+         )

+      | _ -> false

+    ) vmx in

+

+  (* Map the subset to a list of CD-ROMs. *)

+  let devs =

+    Parse_vmx.map (

+      fun path v ->

+        match path, v with

+        | [ns], None ->

+           let c, t = get_ide_controller_target ns in

+           let s = { s_removable_type = CDROM;

+                     s_removable_controller = Some Source_IDE;

+                     s_removable_slot = Some (ide_slot c t) } in

+           Some s

+        | _ -> None

+    ) devs in

+  let devs = filter_map identity devs in

+

+  (* Sort by slot. *)

+  let devs =

+    List.sort

+      (fun { s_removable_slot = s1 } { s_removable_slot = s2 } ->

+        compare s1 s2)

+      devs in

+

+  devs

+

+and ide_slot c t =

+  (* Assuming the old master/slave arrangement. *)

+  c * 2 + t

+

+(* Find all ethernet cards.

+ *

+ * In the VMX file:

+ *   ethernet0.virtualDev = "vmxnet3"

+ *   ethernet0.networkName = "VM Network"

+ *   ethernet0.generatedAddress = "00:01:02:03:04:05"

+ *   ethernet0.connectionType = "bridged" # also: "custom", "nat" or not present

+ *)

+and find_nics vmx =

+  let get_ethernet_port ns =

+    sscanf ns "ethernet%d" (fun p -> p)

+  in

+  let is_ethernet_port ns =

+    try ignore (get_ethernet_port ns); true

+    with Scanf.Scan_failure _ | End_of_file | Failure _ -> false

+  in

+

+  (* Find namespaces matching 'ethernetX'. *)

+  let nics =

+    Parse_vmx.select_namespaces (

+      function

+      | [ns] -> is_ethernet_port ns

+      | _ -> false

+    ) vmx in

+

+  (* Map the subset to a list of NICs. *)

+  let nics =

+    Parse_vmx.map (

+      fun path v ->

+        match path, v with

+        | [ns], None ->

+           let port = get_ethernet_port ns in

+           let mac = Parse_vmx.get_string vmx [ns; "generatedAddress"] in

+           let model = Parse_vmx.get_string vmx [ns; "virtualDev"] in

+           let model =

+             match model with

+             | Some m when String.lowercase_ascii m = "e1000" ->

+                Some Source_e1000

+             | Some model ->

+                Some (Source_other_nic (String.lowercase_ascii model))

+             | None -> None in

+           let vnet = Parse_vmx.get_string vmx [ns; "networkName"] in

+           let vnet =

+             match vnet with

+             | Some vnet -> vnet

+             | None -> ns (* "ethernetX" *) in

+           let vnet_type =

+             match Parse_vmx.get_string vmx [ns; "connectionType"] with

+             | Some b when String.lowercase_ascii b = "bridged" ->

+                Bridge

+             | Some _ | None -> Network in

+           Some (port,

+                 { s_mac = mac; s_nic_model = model;

+                   s_vnet = vnet; s_vnet_orig = vnet;

+                   s_vnet_type = vnet_type })

+        | _ -> None

+    ) nics in

+  let nics = filter_map identity nics in

+

+  (* Sort by port. *)

+  let nics = List.sort compare nics in

+

+  let nics = List.map (fun (_, source) -> source) nics in

+  nics

+

+class input_vmx vmx_filename = object

+  inherit input

+

+  method as_options = "-i vmx " ^ vmx_filename

+

+  method source () =

+    (* Parse the VMX file. *)

+    let vmx = Parse_vmx.parse_file vmx_filename in

+

+    let name =

+      match Parse_vmx.get_string vmx ["displayName"] with

+      | None ->

+         warning (f_"no displayName key found in VMX file");

+         name_from_disk vmx_filename

+      | Some s -> s in

+

+    let memory_mb =

+      match Parse_vmx.get_int64 vmx ["memSize"] with

+      | None -> 32_L            (* default is really 32 MB! *)

+      | Some i -> i in

+    let memory = memory_mb *^ 1024L *^ 1024L in

+

+    let vcpu =

+      match Parse_vmx.get_int vmx ["numvcpus"] with

+      | None -> 1

+      | Some i -> i in

+

+    let firmware =

+      match Parse_vmx.get_string vmx ["firmware"] with

+      | None -> BIOS

+      | Some "efi" -> UEFI

+      (* Other values are not documented for this field ... *)

+      | Some fw ->

+         warning (f_"unknown firmware value '%s', assuming BIOS") fw;

+         BIOS in

+

+    let video =

+      if Parse_vmx.namespace_present vmx ["svga"] then

+        (* We could also parse svga.vramSize. *)

+        Some (Source_other_video "vmvga")

+      else

+        None in

+

+    let sound =

+      match Parse_vmx.get_string vmx ["sound"; "virtualDev"] with

+      | Some ("sb16") -> Some { s_sound_model = SB16 }

+      | Some ("es1371") -> Some { s_sound_model = ES1370 (* hmmm ... *) }

+      | Some "hdaudio" -> Some { s_sound_model = ICH6 (* intel-hda *) }

+      | Some model ->

+         warning (f_"unknown sound device '%s' ignored") model;

+         None

+      | None -> None in

+

+    let disks = find_disks vmx vmx_filename in

+    let removables = find_removables vmx in

+    let nics = find_nics vmx in

+

+    let source = {

+      s_hypervisor = VMware;

+      s_name = name;

+      s_orig_name = name;

+      s_memory = memory;

+      s_vcpu = vcpu;

+      s_features = [];

+      s_firmware = firmware;

+      s_display = None;

+      s_video = video;

+      s_sound = sound;

+      s_disks = disks;

+      s_removables = removables;

+      s_nics = nics;

+    } in

+

+    source

+end

+

+let input_vmx = new input_vmx

+let () = Modules_list.register_input_module "vmx"

diff --git a/v2v/input_vmx.mli b/v2v/input_vmx.mli

new file mode 100644

index 000000000..f236f8716

--- /dev/null

+++ b/v2v/input_vmx.mli

@@ -0,0 +1,22 @@

+(* virt-v2v

+ * Copyright (C) 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.

+ *)

+

+(** [-i vmx] source. *)

+

+val input_vmx : string -> Types.input

+(** [input_vmx filename] sets up an input from vmware vmx file. *)

diff --git a/v2v/name_from_disk.ml b/v2v/name_from_disk.ml

index 82f09250a..452d9462c 100644

--- a/v2v/name_from_disk.ml

+++ b/v2v/name_from_disk.ml

@@ -24,7 +24,7 @@ let name_from_disk disk =

   (* Remove the extension (or suffix), only if it's one usually

    * used for disk images. *)

   let suffixes = [

-    ".img"; ".ova"; ".qcow2"; ".raw"; ".vmdk";

+    ".img"; ".ova"; ".qcow2"; ".raw"; ".vmdk"; ".vmx";

     "-sda";

   ] in

   let rec loop = function

diff --git a/v2v/parse_vmx.ml b/v2v/parse_vmx.ml

new file mode 100644

index 000000000..33ec17d3d

--- /dev/null

+++ b/v2v/parse_vmx.ml

@@ -0,0 +1,381 @@

+(* virt-v2v

+ * Copyright (C) 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.

+ *)

+

+open Printf

+

+open Common_utils

+open Common_gettext.Gettext

+

+(* As far as I can tell the VMX format is totally unspecified.

+ * However libvirt has a useful selection of .vmx files in the

+ * sources which explore some of the darker regions of this

+ * format.

+ *

+ * So here are some facts about VMX derived from libvirt and

+ * other places:

+ *

+ * - Keys are compared case insensitively.  We assume here

+ *   that keys are 7-bit ASCII.

+ *

+ * - Multiple keys with the same name are not allowed.

+ *

+ * - Escaping in the value string is possible using a very weird

+ *   escape format: "|22" means the character '\x22'.  To write

+ *   a pipe character you must use "|7C".

+ *

+ * - Boolean values are written "TRUE", "FALSE", "True", "true", etc.

+ *   Because of the quotes they cannot be distinguished from strings.

+ *

+ * - Comments (#...) and blank lines are ignored.  Some files start

+ *   with a hash-bang path, but we ignore those as comments.  This

+ *   parser also ignores any other line which it doesn't understand,

+ *   but will print a warning.

+ *

+ * - Multi-line values are not permitted.

+ *

+ * - Keys are namespaced using dots, eg. scsi0:0.deviceType has

+ *   the namespace "scsi0:0" and the key name "deviceType".

+ *

+ * - Using namespace.present = "FALSE" means that all other keys

+ *   in and under the namespace are ignored.

+ *

+ * - You cannot have a namespace and a key with the same name, eg.

+ *   this is not allowed:

+ *     namespace = "some value"

+ *     namespace.foo = "another value"

+ *

+ * - The Hashicorp packer VMX writer considers some special keys

+ *   as not requiring any quotes around their values, but I'm

+ *   ignoring that for now.

+ *)

+

+(* This VMX file:

+ *

+ *   foo.a = "abc"

+ *   foo.b = "def"

+ *   foo.bar.c = "abc"

+ *   foo.bar.d = "def"

+ *

+ * would be represented by this structure:

+ *

+ *   "foo" => Namespace (             # "foo" is a namespace

+ *              "a" => Key "abc";     # "foo.a" is a key with value "abc"

+ *              "b" => Key "def";

+ *              "bar" => Namespace (  # "foo.bar" is another namespace

+ *                         "c" => Key "abc";

+ *                         "d" => Key "def";

+ *                       )

+ *            )

+ *   ‘( => )’s represent the StringMap type.

+ *)

+type t = key StringMap.t

+

+and key =

+  | Key of string

+  | Namespace of t

+

+let empty = StringMap.empty

+

+(* Compare two trees for equality. *)

+let rec equal vmx1 vmx2 =

+  let cmp k1 k2 =

+    match k1, k2 with

+    | Key v1, Key v2 -> v1 = v2

+    | Key _, Namespace _ -> false

+    | Namespace _, Key _ -> false

+    | Namespace vmx1, Namespace vmx2 -> equal vmx1 vmx2

+  in

+  StringMap.equal cmp vmx1 vmx2

+

+(* Higher-order functions. *)

+let rec select_namespaces pred vmx =

+  _select_namespaces [] pred vmx

+

+and _select_namespaces path pred vmx =

+  StringMap.fold (

+    fun k v new_vmx ->

+      let path = path @ [k] in

+      match v with

+      | Key _ -> new_vmx

+      | Namespace _ when pred path ->

+         StringMap.add k v new_vmx

+      | Namespace t ->

+         let t = _select_namespaces path pred t in

+         if not (equal t empty) then

+           StringMap.add k (Namespace t) new_vmx

+         else

+           new_vmx

+  ) vmx empty

+

+let rec map f vmx =

+  _map [] f vmx

+

+and _map path f vmx =

+  StringMap.fold (

+    fun k v r ->

+      let path = path @ [k] in

+      match v with

+      | Key v -> r @ [ f path (Some v) ]

+      | Namespace t -> r @ [ f path None ] @ _map path f t

+  ) vmx []

+

+let rec namespace_present vmx = function

+  | [] -> false

+  | [ns] ->

+     let ns = String.lowercase_ascii ns in

+     (try

+        let v = StringMap.find ns vmx in

+        match v with

+        | Key _ -> false

+        | Namespace _ -> true

+      with

+        Not_found -> false

+     )

+  | ns :: path ->

+     let ns = String.lowercase_ascii ns in

+     (try

+        let v = StringMap.find ns vmx in

+        match v with

+        | Key _ -> false

+        | Namespace vmx -> namespace_present vmx path

+      with

+        Not_found -> false

+     )

+

+(* Dump the vmx structure to [chan].  Used for debugging. *)

+let rec print chan indent vmx =

+  StringMap.iter (print_key chan indent) vmx

+

+and print_key chan indent k = function