9:08 a.m.
This function will allow more OCaml-ish processing of XPath queries
with multiple results.
---
common/mltools/xpath_helpers.ml | 9 +++++++
common/mltools/xpath_helpers.mli | 4 +++
v2v/output_libvirt.ml | 11 ++------
v2v/test-harness/v2v_test_harness.ml | 51 +++++++++++-------------------------
4 files changed, 30 insertions(+), 45 deletions(-)
diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml
index 3afee8b21..d2bfd3fb9 100644
--- a/common/mltools/xpath_helpers.ml
+++ b/common/mltools/xpath_helpers.ml
@@ -40,3 +40,12 @@ let xpath_eval parsefn xpathctx expr =
let xpath_string = xpath_eval identity
let xpath_int = xpath_eval int_of_string
let xpath_int64 = xpath_eval Int64.of_string
+
+let xpath_get_nodes xpathctx expr =
+ let obj = Xml.xpath_eval_expression xpathctx expr in
+ let nodes = ref [] in
+ for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
+ let node = Xml.xpathobj_node obj i in
+ push_front node nodes
+ done;
+ List.rev !nodes
diff --git a/common/mltools/xpath_helpers.mli b/common/mltools/xpath_helpers.mli
index 3a8190b05..3a2607aeb 100644
--- a/common/mltools/xpath_helpers.mli
+++ b/common/mltools/xpath_helpers.mli
@@ -25,3 +25,7 @@ val xpath_int : Xml.xpathctx -> string -> int option
val xpath_int64 : Xml.xpathctx -> string -> int64 option
(** Parse an xpath expression and return a string/int. Returns
[Some v], or [None] if the expression doesn't match. *)
+
+val xpath_get_nodes : Xml.xpathctx -> string -> Xml.node list
+(** Parse an XPath expression and return a list with the matching
+ XML nodes. *)
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
index 02b4d54ff..729f8b67a 100644
--- a/v2v/output_libvirt.ml
+++ b/v2v/output_libvirt.ml
@@ -55,15 +55,8 @@ let target_features_of_capabilities_doc doc arch =
Xml.xpathctx_set_current_context xpathctx node;
(* Get guest/features/* nodes. *)
- let obj = Xml.xpath_eval_expression xpathctx "features/*" in
-
- let features = ref [] in
- for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
- let feature_node = Xml.xpathobj_node obj i in
- let feature_name = Xml.node_name feature_node in
- push_front feature_name features
- done;
- !features
+ let features = xpath_get_nodes xpathctx "features/*" in
+ List.map Xml.node_name features
)
class output_libvirt oc output_pool = object
diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml
index ae0033dde..79e97a4b2 100644
--- a/v2v/test-harness/v2v_test_harness.ml
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -25,6 +25,7 @@ open Printf
open Std_utils
open Tools_utils
+open Xpath_helpers
type test_plan = {
guest_clock : float option;
@@ -90,29 +91,18 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () =
g, root
in
- let nodes_of_xpathobj doc xpathobj =
- let nodes = ref [] in
- for i = 0 to Xml.xpathobj_nr_nodes xpathobj - 1 do
- push_front (Xml.xpathobj_node xpathobj i) nodes
- done;
- List.rev !nodes
- in
-
let test_boot boot_disk boot_xml_doc =
(* Modify boot XML (in memory). *)
let xpathctx = Xml.xpath_new_context boot_xml_doc in
(* Change <name> to something unique. *)
let domname = "tmpv2v-" ^ test in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/name" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/name" in
List.iter (fun node -> Xml.node_set_content node domname) nodes;
(* Limit the RAM used by the guest to 2GB. *)
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/memory" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/currentMemory" in
- let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/memory" in
+ let nodes = nodes @ xpath_get_nodes xpathctx "/domain/currentMemory" in
List.iter (
fun node ->
let i = int_of_string (Xml.node_as_string node) in
@@ -127,8 +117,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () =
let adjustment = t -. time () in
assert (adjustment <= 0.);
let adjustment = int_of_float adjustment in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/clock" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/clock" in
let clock_node =
match nodes with
| [] ->
@@ -147,8 +136,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () =
);
(* Remove all devices except for a whitelist. *)
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/devices/*" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/devices/*" in
List.iter (
fun node ->
match Xml.node_name node with
@@ -157,33 +145,26 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) ()
=
) nodes;
(* Remove CDROMs. *)
- let xpath =
- Xml.xpath_eval_expression xpathctx
- "/domain/devices/disk[@device=\"cdrom\"]" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx
+ "/domain/devices/disk[@device=\"cdrom\"]" in
List.iter Xml.unlink_node nodes;
(* Change <on_*> settings to destroy ... *)
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_poweroff" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_crash" in
- let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/on_poweroff" in
+ let nodes = nodes @ xpath_get_nodes xpathctx "/domain/on_crash" in
List.iter (fun node -> Xml.node_set_content node "destroy") nodes;
(* ... except for <on_reboot> which is permitted (for SELinux
* relabelling)
*)
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_reboot" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/on_reboot" in
List.iter (fun node -> Xml.node_set_content node "restart") nodes;
(* Get the name of the disk device (eg. "sda"), which is used
* for getting disk stats.
*)
- let xpath =
- Xml.xpath_eval_expression xpathctx
- "/domain/devices/disk[@device=\"disk\"]/target/@dev" in
let dev =
- match nodes_of_xpathobj boot_xml_doc xpath with
+ match xpath_get_nodes xpathctx
+ "/domain/devices/disk[@device=\"disk\"]/target/@dev" with
| [node] -> Xml.node_as_string node
| _ -> assert false in
@@ -523,10 +504,8 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) ()
=
(* We need to remember to change the XML to point to the boot overlay. *)
let () =
let xpathctx = Xml.xpath_new_context boot_xml_doc in
- let xpath =
- Xml.xpath_eval_expression xpathctx
- "/domain/devices/disk[@device=\"disk\"]/source" in
- match nodes_of_xpathobj boot_xml_doc xpath with
+ match xpath_get_nodes xpathctx
+ "/domain/devices/disk[@device=\"disk\"]/source" with
| [node] ->
(* Libvirt requires that the path is absolute. *)
let abs_boot_disk = Sys.getcwd () // boot_disk in
--
2.13.2