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.

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index 15da362..8049f42 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 */