Re: [Libguestfs] [PATCH v11 7/8] mllib: add XPath helper xpath_get_nodes

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