X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=libvirt%2Flibvirt.ml;h=53c5bb470b3408c4fd076c084dd338557c25c114;hb=refs%2Ftags%2F0.6.1.1;hp=2ffdac95912b08a078063f093a827c00f63a0ea0;hpb=71815ab2e638e2c1121d40520ac5b888b1b48bd6;p=ocaml-libvirt.git

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index 2ffdac9..53c5bb4 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -341,6 +341,13 @@ struct
     | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64
     | SchedFieldFloat of float | SchedFieldBool of bool
 
+  type typed_param = string * typed_param_value
+  and typed_param_value =
+    | TypedFieldInt32 of int32 | TypedFieldUInt32 of int32
+    | TypedFieldInt64 of int64 | TypedFieldUInt64 of int64
+    | TypedFieldFloat of float | TypedFieldBool of bool
+    | TypedFieldString of string
+
   type migrate_flag = Live
 
   type memory_flag = Virtual
@@ -375,8 +382,6 @@ struct
    *)
   let max_peek _ = 65536
 
-  external list_all_domains : 'a Connect.t -> ?want_info:bool -> list_flag list -> 'a t array * info array = "ocaml_libvirt_connect_list_all_domains"
-
   external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux"
   external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id"
   external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid"
@@ -412,6 +417,7 @@ struct
   external set_vcpus : [>`W] t -> int -> unit = "ocaml_libvirt_domain_set_vcpus"
   external pin_vcpu : [>`W] t -> int -> string -> unit = "ocaml_libvirt_domain_pin_vcpu"
   external get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string = "ocaml_libvirt_domain_get_vcpus"
+  external get_cpu_stats : [>`R] t -> int -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats"
   external get_max_vcpus : [>`R] t -> int = "ocaml_libvirt_domain_get_max_vcpus"
   external attach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_attach_device"
   external detach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_detach_device"
@@ -423,94 +429,56 @@ struct
 
   external const : [>`R] t -> ro t = "%identity"
 
-  (* First time we are called, we will check if
-   * virConnectListAllDomains is supported.
-   *)
-  let have_list_all_domains = ref None
-
-  let check_have_list_all_domains conn =
-    match !have_list_all_domains with
-    | Some v -> v
-    | None ->
-	(* Check if virConnectListAllDomains is supported
-	 * by this version of libvirt.
-	 *)
-	let v =
-	  (* libvirt has a short-cut which makes this very quick ... *)
-	  try ignore (list_all_domains conn []); true
-	  with Not_supported "virConnectListAllDomains" -> false in
-	have_list_all_domains := Some v;
-	v
-
   let get_domains conn flags =
-    let have_list_all_domains = check_have_list_all_domains conn in
-
-    if have_list_all_domains then (
-      (* Good, we can use the shiny new method. *)
-      let doms, _ = list_all_domains conn ~want_info:false flags in
-      Array.to_list doms
-    )
-    else (
-      (* Old/slow/inefficient method. *)
-      let get_active, get_inactive =
-	if List.mem ListAll flags then
-	  (true, true)
-	else
-	  (List.mem ListActive flags, List.mem ListInactive flags) in
-      let active_doms =
-	if get_active then (
-	  let n = Connect.num_of_domains conn in
-	  let ids = Connect.list_domains conn n in
-	  let ids = Array.to_list ids in
-	  map_ignore_errors (lookup_by_id conn) ids
-	) else [] in
-
-      let inactive_doms =
-	if get_inactive then (
-	  let n = Connect.num_of_defined_domains conn in
-	  let names = Connect.list_defined_domains conn n in
-	  let names = Array.to_list names in
-	  map_ignore_errors (lookup_by_name conn) names
-	) else [] in
-
-      active_doms @ inactive_doms
-    )
+    (* Old/slow/inefficient method. *)
+    let get_active, get_inactive =
+      if List.mem ListAll flags then
+	(true, true)
+      else
+	(List.mem ListActive flags, List.mem ListInactive flags) in
+    let active_doms =
+      if get_active then (
+	let n = Connect.num_of_domains conn in
+	let ids = Connect.list_domains conn n in
+	let ids = Array.to_list ids in
+	map_ignore_errors (lookup_by_id conn) ids
+      ) else [] in
+
+    let inactive_doms =
+      if get_inactive then (
+	let n = Connect.num_of_defined_domains conn in
+	let names = Connect.list_defined_domains conn n in
+	let names = Array.to_list names in
+	map_ignore_errors (lookup_by_name conn) names
+      ) else [] in
+
+    active_doms @ inactive_doms
 
   let get_domains_and_infos conn flags =
-    let have_list_all_domains = check_have_list_all_domains conn in
-
-    if have_list_all_domains then (
-      (* Good, we can use the shiny new method. *)
-      let doms, infos = list_all_domains conn ~want_info:true flags in
-      let doms = Array.to_list doms and infos = Array.to_list infos in
-      List.combine doms infos
-    )
-    else (
-      (* Old/slow/inefficient method. *)
-      let get_active, get_inactive =
-	if List.mem ListAll flags then
-	  (true, true)
-	else (List.mem ListActive flags, List.mem ListInactive flags) in
-      let active_doms =
-	if get_active then (
-	  let n = Connect.num_of_domains conn in
-	  let ids = Connect.list_domains conn n in
-	  let ids = Array.to_list ids in
-	  map_ignore_errors (lookup_by_id conn) ids
-	) else [] in
-
-      let inactive_doms =
-	if get_inactive then (
-	  let n = Connect.num_of_defined_domains conn in
-	  let names = Connect.list_defined_domains conn n in
-	  let names = Array.to_list names in
-	  map_ignore_errors (lookup_by_name conn) names
-	) else [] in
-
-      let doms = active_doms @ inactive_doms in
-
-      map_ignore_errors (fun dom -> (dom, get_info dom)) doms
-    )
+    (* Old/slow/inefficient method. *)
+    let get_active, get_inactive =
+      if List.mem ListAll flags then
+	(true, true)
+      else (List.mem ListActive flags, List.mem ListInactive flags) in
+    let active_doms =
+      if get_active then (
+	let n = Connect.num_of_domains conn in
+	let ids = Connect.list_domains conn n in
+	let ids = Array.to_list ids in
+	map_ignore_errors (lookup_by_id conn) ids
+      ) else [] in
+
+    let inactive_doms =
+      if get_inactive then (
+	let n = Connect.num_of_defined_domains conn in
+	let names = Connect.list_defined_domains conn n in
+	let names = Array.to_list names in
+	map_ignore_errors (lookup_by_name conn) names
+      ) else [] in
+
+    let doms = active_doms @ inactive_doms in
+
+    map_ignore_errors (fun dom -> (dom, get_info dom)) doms
 end
 
 module Network =