[Libguestfs] [PATCH v11 7/8] mllib: add XPath helper xpath_get_nodes
Richard W.M. Jones
rjones at redhat.com
Tue Nov 7 12:22:03 UTC 2017
On Fri, Oct 27, 2017 at 04:08:21PM +0200, Cédric Bosdonnat wrote:
> 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
ACK
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW
More information about the Libguestfs
mailing list