From 8e2a0e31bd1cf6af2d8eab0fa7582c52a3b2d9ab Mon Sep 17 00:00:00 2001
From: Pino Toscano <ptoscano@redhat.com>
Date: Thu, 30 Aug 2018 12:13:38 +0200
Subject: [PATCH] Add Domain.get_xml_desc_flags

Much like Domain.get_xml_desc with the possibility to specify flags for
the XML description.  The function is marked with a [`W] phantom because
some of the flags (e.g. XmlSecure) require a read/write connection.
---
 libvirt/libvirt.ml          |  7 +++++++
 libvirt/libvirt.mli         |  9 +++++++++
 libvirt/libvirt_c_oneoffs.c | 31 +++++++++++++++++++++++++++++++
 3 files changed, 47 insertions(+)

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index 15da362..8049f42 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -640,6 +640,12 @@ struct
     params : typed_param array;
   }
 
+  type xml_desc_flag =
+    | XmlSecure
+    | XmlInactive
+    | XmlUpdateCPU
+    | XmlMigratable
+
   (* The maximum size for Domain.memory_peek and Domain.block_peek
    * supported by libvirt.  This may change with different versions
    * of libvirt in the future, hence it's a function.
@@ -673,6 +679,7 @@ struct
   external set_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_memory"
   external get_info : [>`R] t -> info = "ocaml_libvirt_domain_get_info"
   external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_domain_get_xml_desc"
+  external get_xml_desc_flags : [>`W] t -> xml_desc_flag list -> xml = "ocaml_libvirt_domain_get_xml_desc_flags"
   external get_scheduler_type : [>`R] t -> string * int = "ocaml_libvirt_domain_get_scheduler_type"
   external get_scheduler_parameters : [>`R] t -> int -> sched_param array = "ocaml_libvirt_domain_get_scheduler_parameters"
   external set_scheduler_parameters : [>`W] t -> sched_param array -> unit = "ocaml_libvirt_domain_set_scheduler_parameters"
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index 77e110e..ff8d4ca 100644
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -534,6 +534,12 @@ sig
     params : typed_param array;
   }
 
+  type xml_desc_flag =
+    | XmlSecure			(* dump security sensitive information too *)
+    | XmlInactive		(* dump inactive domain information *)
+    | XmlUpdateCPU		(* update guest CPU requirements according to host CPU *)
+    | XmlMigratable		(* dump XML suitable for migration *)
+
   val max_peek : [>`R] t -> int
     (** Maximum size supported by the {!block_peek} and {!memory_peek}
 	functions.  If you want to peek more than this then you must
@@ -598,6 +604,9 @@ sig
     (** Get information about a domain. *)
   val get_xml_desc : [>`R] t -> xml
     (** Get the XML description of a domain. *)
+  val get_xml_desc_flags : [>`W] t -> xml_desc_flag list -> xml
+    (** Get the XML description of a domain, with the possibility
+	to specify flags. *)
   val get_scheduler_type : [>`R] t -> string * int
     (** Get the scheduler type. *)
   val get_scheduler_parameters : [>`R] t -> int -> sched_param array
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 11612f6..72543d7 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -977,6 +977,37 @@ ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
                                                   argv[3], argv[4], argv[5]);
 }
 
+CAMLprim value
+ocaml_libvirt_domain_get_xml_desc_flags (value domv, value flagsv)
+{
+  CAMLparam2 (domv, flagsv);
+  CAMLlocal2 (rv, flagv);
+  virDomainPtr dom = Domain_val (domv);
+  int flags = 0;
+  char *r;
+
+  /* Do flags. */
+  for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
+    {
+      flagv = Field (flagsv, 0);
+      if (flagv == Val_int (0))
+        flags |= VIR_DOMAIN_XML_SECURE;
+      else if (flagv == Val_int (1))
+        flags |= VIR_DOMAIN_XML_INACTIVE;
+      else if (flagv == Val_int (2))
+        flags |= VIR_DOMAIN_XML_UPDATE_CPU;
+      else if (flagv == Val_int (3))
+        flags |= VIR_DOMAIN_XML_MIGRATABLE;
+    }
+
+  NONBLOCKING (r = virDomainGetXMLDesc (dom, flags));
+  CHECK_ERROR (!r, "virDomainGetXMLDesc");
+
+  rv = caml_copy_string (r);
+  free (r);
+  CAMLreturn (rv);
+}
+
 /*----------------------------------------------------------------------*/
 
 /* Domain events */
-- 
1.8.3.1