*)
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"
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 =
functions. If you want to peek more than this then you must
break your request into chunks. *)
- val list_all_domains : 'a Connect.t -> ?want_info:bool -> list_flag list -> 'a t array * info array
- (** [list_all_domains conn flags] returns all domains which
- match [flags].
-
- This can return both active and inactive domains. The
- list of flags controls what domains are returned. See
- {!list_flag}.
-
- The two arrays returned will have the same length, unless
- [~want_info] is [false] in which case the info array
- will be zero-length. The default for [~want_info] is [true].
- In most cases there is no extra penalty for getting the
- info fields, or the penalty is insignificant.
-
- This call was introduced in libvirt 0.4.5. Because you
- might dynamically link to an older version of libvirt which
- doesn't have this call, you should use {!get_domains}
- or {!get_domains_and_infos} which use the most efficient
- way to get domains for the available version of libvirt.
- *)
val create_linux : [>`W] Connect.t -> xml -> rw t
(** Create a new guest domain (not necessarily a Linux one)
from the given XML.
See also:
{!get_domains_and_infos},
- {!list_all_domains},
{!Connect.list_domains},
{!Connect.list_defined_domains}.
*)
See also:
{!get_domains},
- {!list_all_domains},
{!Connect.list_domains},
{!Connect.list_defined_domains},
{!get_info}.
#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTLISTALLDOMAINS
-extern int virConnectListAllDomains (virConnectPtr conn,
- virDomainPtr **domains,
- virDomainInfo **infos,
- unsigned long stateflags,
- unsigned long flags)
- __attribute__((weak));
-#endif
-#endif
-
-CAMLprim value
-ocaml_libvirt_connect_list_all_domains (value connv,
- value wantinfov,
- value flagsv)
-{
-#ifdef HAVE_VIRCONNECTLISTALLDOMAINS
- CAMLparam3 (connv, wantinfov, flagsv);
- CAMLlocal4 (flagv, rv, rv1, rv2);
- CAMLlocal2 (v1, v2);
- virConnectPtr conn = Connect_val (connv);
- virDomainPtr *domains;
- virDomainInfo *infos;
- int want_info, i, r, flag;
- unsigned long flags = 0;
-
- /* ?want_info */
- if (wantinfov == Val_int (0)) /* None == true */
- want_info = 1;
- else
- want_info = Bool_val (Field (wantinfov, 0));
-
- /* Iterate over the list of flags. */
- for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
- flagv = Field (flagsv, 0);
- flag = Int_val (flagv);
- switch (flag) {
- case 0: flags |= VIR_DOMAIN_LIST_ACTIVE; break;
- case 1: flags |= VIR_DOMAIN_LIST_INACTIVE; break;
- case 2: flags |= VIR_DOMAIN_LIST_ALL; break;
- }
- }
-
- WEAK_SYMBOL_CHECK (virConnectListAllDomains);
- NONBLOCKING (r = virConnectListAllDomains (conn, &domains,
- want_info ? &infos : NULL,
- flags, 0));
- CHECK_ERROR (r == -1, conn, "virConnectListAllDomains");
-
- /* Convert the result into a pair of arrays. */
- rv1 = caml_alloc (r, 0);
- for (i = 0; i < r; ++i) {
- v1 = Val_domain (domains[i], connv);
- Store_field (rv1, i, v1);
- }
- free (domains);
-
- if (want_info) {
- rv2 = caml_alloc (r, 0);
-
- for (i = 0; i < r; ++i) {
- v1 = caml_alloc (5, 0);
- Store_field (v1, 0, Val_int (infos[i].state));
- v2 = caml_copy_int64 (infos[i].maxMem); Store_field (v1, 1, v2);
- v2 = caml_copy_int64 (infos[i].memory); Store_field (v1, 2, v2);
- Store_field (v1, 3, Val_int (infos[i].nrVirtCpu));
- v2 = caml_copy_int64 (infos[i].cpuTime); Store_field (v1, 4, v2);
-
- Store_field (rv2, i, v1);
- }
-
- free (infos);
- }
- else
- rv2 = caml_alloc (0, 0); /* zero-length array */
-
- rv = caml_alloc_tuple (2);
- Store_field (rv, 0, rv1);
- Store_field (rv, 1, rv2);
- CAMLreturn (rv);
-#else
- not_supported ("virConnectListAllDomains");
-#endif
-}
-
CAMLprim value
ocaml_libvirt_domain_get_id (value domv)
{
git.annexia.org / ocaml-libvirt.git / commitdiff