Add support for virConnectListAllDomains call.

diff --git a/config.h.in b/config.h.in
index 68f6bbf..50d3724 100644 (file)
--- a/config.h.in
+++ b/config.h.in
@@ -36,6 +36,9 @@
 /* Define to 1 if you have the `virConnectGetURI' function. */
 #undef HAVE_VIRCONNECTGETURI
 
 /* Define to 1 if you have the `virConnectGetURI' function. */
 #undef HAVE_VIRCONNECTGETURI
 

+/* Define to 1 if you have the `virConnectListAllDomains' function. */
+#undef HAVE_VIRCONNECTLISTALLDOMAINS
+

 /* Define to 1 if you have the `virConnectListDefinedStoragePools' function.
    */
 #undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS
 /* Define to 1 if you have the `virConnectListDefinedStoragePools' function.
    */
 #undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS

diff --git a/configure.ac b/configure.ac
index 5951887..acca266 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -125,6 +125,7 @@ AC_CHECK_FUNCS([virConnectGetHostname \
                virStorageVolGetPath \
                virDomainBlockPeek \
                virDomainMemoryPeek \
                virStorageVolGetPath \
                virDomainBlockPeek \
                virDomainMemoryPeek \

+               virConnectListAllDomains \

 ])
 
 # This jobs API was never published and is due to get overhauled
 ])
 
 # This jobs API was never published and is due to get overhauled

diff --git a/examples/list_domains.ml b/examples/list_domains.ml
index c97432c..2e9e436 100644 (file)
--- a/examples/list_domains.ml
+++ b/examples/list_domains.ml
@@ -20,21 +20,20 @@ let () =
     let conn = C.connect_readonly ?name () in
 
     (* List running domains. *)
     let conn = C.connect_readonly ?name () in
 
     (* List running domains. *)

-    let n = C.num_of_domains conn in
-    let ids = C.list_domains conn n in
-    let domains = Array.map (D.lookup_by_id conn) ids in
-    Array.iter (
+    let domains =
+      fst (Libvirt.get_domains conn ~want_info:false [D.ListActive]) in
+    List.iter (

       fun dom ->
        printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom)
     ) domains;
 
     (* List inactive domains. *)
       fun dom ->
        printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom)
     ) domains;
 
     (* List inactive domains. *)

-    let n = C.num_of_defined_domains conn in
-    let names = C.list_defined_domains conn n in
-    Array.iter (
-      fun name ->
-       printf "inactive %s\n%!" name
-    ) names;
+    let domains =
+      fst (Libvirt.get_domains conn ~want_info:false [D.ListInactive]) in
+    List.iter (
+      fun dom ->
+       printf "inactive %s\n%!" (D.get_name dom)
+    ) domains;

   with
     Libvirt.Virterror err ->
       eprintf "error: %s\n" (Libvirt.Virterror.to_string err)
   with
     Libvirt.Virterror err ->
       eprintf "error: %s\n" (Libvirt.Virterror.to_string err)

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index daf7f38..1e37136 100644 (file)
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -50,6 +50,13 @@ struct
     threads : int;
   }
 
     threads : int;
   }
 

+  type list_flag =
+    | ListNoState | ListRunning | ListBlocked
+    | ListPaused | ListShutdown | ListShutoff | ListCrashed
+    | ListActive
+    | ListInactive
+    | ListAll
+

   external connect : ?name:string -> unit -> rw t = "ocaml_libvirt_connect_open"
   external connect_readonly : ?name:string -> unit -> ro t = "ocaml_libvirt_connect_open_readonly"
   external close : [>`R] t -> unit = "ocaml_libvirt_connect_close"
   external connect : ?name:string -> unit -> rw t = "ocaml_libvirt_connect_open"
   external connect_readonly : ?name:string -> unit -> ro t = "ocaml_libvirt_connect_open_readonly"
   external close : [>`R] t -> unit = "ocaml_libvirt_connect_close"


@@ -133,6 +140,13 @@ struct
 
   type memory_flag = Virtual
 
 
   type memory_flag = Virtual
 

+  type list_flag =
+    | ListNoState | ListRunning | ListBlocked
+    | ListPaused | ListShutdown | ListShutoff | ListCrashed
+    | ListActive
+    | ListInactive
+    | ListAll
+

   type block_stats = {
     rd_req : int64;
     rd_bytes : int64;
   type block_stats = {
     rd_req : int64;
     rd_bytes : int64;


@@ -158,6 +172,8 @@ struct
    *)
   let max_peek _ = 65536
 
    *)
   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 create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_domain_create_linux_job"
   external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id"
   external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux"
   external create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_domain_create_linux_job"
   external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id"


@@ -520,6 +536,105 @@ end
 exception Virterror of Virterror.t
 exception Not_supported of string
 
 exception Virterror of Virterror.t
 exception Not_supported of string
 

+let rec map_ignore_errors f = function
+  | [] -> []
+  | x :: xs ->
+      try f x :: map_ignore_errors f xs
+      with Virterror _ -> map_ignore_errors f xs
+
+(* First time we are called, we will check if
+ * virConnectListAllDomains is supported.
+ *)
+let have_list_all_domains = ref None
+
+let get_domains conn ?(want_info = true) flags =
+  let have_list_all_domains =
+    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 (Domain.list_all_domains conn []); true
+         with Not_supported "virConnectListAllDomains" -> false in
+       have_list_all_domains := Some v;
+       v in
+
+  if have_list_all_domains then (
+    (* Good, we can use the shiny new method. *)
+    let doms, infos = Domain.list_all_domains conn ~want_info flags in
+    Array.to_list doms, Array.to_list infos
+  )
+  else (
+    (* Old/slow/inefficient method. *)
+    let get_all, get_active, get_inactive, another_flag =
+      let rec loop ((all, active, inactive, another) as xs) = function
+       | [] -> xs
+       | Domain.ListAll :: _ -> (true, true, true, false)
+       | Domain.ListActive :: fs -> loop (all, true, inactive, another) fs
+       | Domain.ListInactive :: fs -> loop (all, active, true, another) fs
+       | _ -> (true, true, true, true)
+      in
+      loop (false, false, false, false) 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 (Domain.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 (Domain.lookup_by_name conn) names
+      ) else [] in
+
+    let doms = active_doms @ inactive_doms in
+
+    if not another_flag then (
+      if want_info then
+       List.split (
+         map_ignore_errors (fun dom -> (dom, Domain.get_info dom)) doms
+       )
+      else
+       doms, []
+    ) else (
+      (* Slow method: We have to get the infos and filter on state. *)
+      let flag_is_set =
+       let h = Hashtbl.create 13 in
+       List.iter (fun flag -> Hashtbl.add h flag ()) flags;
+       Hashtbl.mem h
+      in
+
+      let doms =
+       map_ignore_errors (fun dom -> (dom, Domain.get_info dom)) doms in
+      let doms = List.filter (
+       fun (dom, { Domain.state = state }) ->
+         match state with
+         | Domain.InfoNoState -> flag_is_set Domain.ListNoState
+         | Domain.InfoRunning ->
+             flag_is_set Domain.ListActive || flag_is_set Domain.ListRunning
+         | Domain.InfoBlocked ->
+             flag_is_set Domain.ListActive || flag_is_set Domain.ListBlocked
+         | Domain.InfoPaused ->
+             flag_is_set Domain.ListActive || flag_is_set Domain.ListPaused
+         | Domain.InfoShutdown ->
+             flag_is_set Domain.ListActive || flag_is_set Domain.ListShutdown
+         | Domain.InfoShutoff ->
+             flag_is_set Domain.ListInactive
+             || flag_is_set Domain.ListShutoff
+         | Domain.InfoCrashed -> flag_is_set Domain.ListCrashed
+      ) doms in
+      List.split doms
+    )
+  )
+

 (* Initialization. *)
 external c_init : unit -> unit = "ocaml_libvirt_init"
 let () =
 (* Initialization. *)
 external c_init : unit -> unit = "ocaml_libvirt_init"
 let () =

diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index ec945b7..052d4c0 100644 (file)
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -61,47 +61,46 @@ v}
    {{:http://libvirt.org/html/libvirt-libvirt.html}virConnect*, virDomain* and virNetwork* functions from libvirt}.
    For brevity I usually rename these modules like this:
 
    {{:http://libvirt.org/html/libvirt-libvirt.html}virConnect*, virDomain* and virNetwork* functions from libvirt}.
    For brevity I usually rename these modules like this:
 

-{v
+{[

 module C = Libvirt.Connect
 module D = Libvirt.Domain
 module N = Libvirt.Network
 module C = Libvirt.Connect
 module D = Libvirt.Domain
 module N = Libvirt.Network

-v}
+]}

 
    To get a connection handle, assuming a Xen hypervisor:
 
 
    To get a connection handle, assuming a Xen hypervisor:
 

-{v
+{[

 let name = "xen:///"
 let conn = C.connect_readonly ~name ()
 let name = "xen:///"
 let conn = C.connect_readonly ~name ()

-v}
+]}

 
    {3 Example: List running domains}
 
 
    {3 Example: List running domains}
 

-{v
+{[

 open Printf
 
 open Printf
 

-let n = C.num_of_domains conn in
-let ids = C.list_domains conn n in
-let domains = Array.map (D.lookup_by_id conn) ids in
-Array.iter (
+let domains =
+  fst (Libvirt.get_domains conn ~want_info:false [D.ListActive]) in
+List.iter (

   fun dom ->
     printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom)
 ) domains;
   fun dom ->
     printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom)
 ) domains;

-v}
+]}

 
    {3 Example: List inactive domains}
 
 
    {3 Example: List inactive domains}
 

-{v
-let n = C.num_of_defined_domains conn in
-let names = C.list_defined_domains conn n in
-Array.iter (
-  fun name ->
-    printf "inactive %s\n%!" name
-) names;
-v}
+{[
+let domains =
+  fst (Libvirt.get_domains conn ~want_info:false [D.ListInactive]) in
+List.iter (
+  fun dom ->
+    printf "inactive %s\n%!" (D.get_name dom)
+) domains;
+]}

 
    {3 Example: Print node info}
 
 
    {3 Example: Print node info}
 

-{v
+{[

 let node_info = C.get_node_info conn in
 printf "model = %s\n" node_info.C.model;
 printf "memory = %Ld K\n" node_info.C.memory;
 let node_info = C.get_node_info conn in
 printf "model = %s\n" node_info.C.model;
 printf "memory = %Ld K\n" node_info.C.memory;


@@ -117,7 +116,7 @@ printf "hostname = %s\n%!" hostname;
 
 let uri = C.get_uri conn in
 printf "uri = %s\n%!" uri
 
 let uri = C.get_uri conn in
 printf "uri = %s\n%!" uri

-v}
+]}

 
 *)
 
 
 *)
 


@@ -140,7 +139,7 @@ v}
     Note that even though you hold open (eg) a domain object, that
     doesn't mean that the domain (virtual machine) actually exists.
     The domain could have been shut down or deleted by another user.
     Note that even though you hold open (eg) a domain object, that
     doesn't mean that the domain (virtual machine) actually exists.
     The domain could have been shut down or deleted by another user.

-    Thus domain objects can through odd exceptions at any time.
+    Thus domain objects can raise odd exceptions at any time.

     This is just the nature of virtualisation.
 
     {3 Backwards and forwards compatibility}
     This is just the nature of virtualisation.
 
     {3 Backwards and forwards compatibility}


@@ -158,6 +157,14 @@ v}
 
     We don't support libvirt < 0.2.1, and never will so don't ask us.
 
 
     We don't support libvirt < 0.2.1, and never will so don't ask us.
 

+    {3 Get list of domains}
+
+    This is a very common operation, and libvirt supports various
+    different methods to do it.  We have hidden the complexity in a
+    flexible {!Libvirt.get_domains} call which is easy to use and
+    automatically chooses the most efficient method depending on the
+    version of libvirt in use.
+

     {3 Threads}
 
     You can issue multiple concurrent libvirt requests in
     {3 Threads}
 
     You can issue multiple concurrent libvirt requests in


@@ -227,17 +234,23 @@ type ro = [`R]
 
        If you want to handle both read-write and read-only
        connections at runtime, use a variant similar to this:
 
        If you want to handle both read-write and read-only
        connections at runtime, use a variant similar to this:

-{v
+{[

 type conn_t =
     | No_connection
     | Read_only of Libvirt.ro Libvirt.Connect.t
     | Read_write of Libvirt.rw Libvirt.Connect.t
 type conn_t =
     | No_connection
     | Read_only of Libvirt.ro Libvirt.Connect.t
     | Read_write of Libvirt.rw Libvirt.Connect.t

-v}
+]}

        See also the source of [mlvirsh].
     *)
 
        See also the source of [mlvirsh].
     *)
 

+(** {3 Forward definitions}
+
+    These definitions are placed here to avoid the need to
+    use recursive module dependencies.
+*)
+

 type ('a, 'b) job_t
 type ('a, 'b) job_t

-(** Forward definition of {!Job.t} to avoid recursive module dependencies. *)
+(** Forward definition of {!Job.t}. *)

 
 (** {3 Connections} *)
 
 
 (** {3 Connections} *)
 


@@ -293,7 +306,10 @@ sig
   val list_domains : [>`R] t -> int -> int array
     (** [list_domains conn max] returns the running domain IDs,
        up to a maximum of [max] entries.
   val list_domains : [>`R] t -> int -> int array
     (** [list_domains conn max] returns the running domain IDs,
        up to a maximum of [max] entries.

+

        Call {!num_of_domains} first to get a value for [max].
        Call {!num_of_domains} first to get a value for [max].

+
+       See also: {!Libvirt.get_domains}.

     *)
   val num_of_domains : [>`R] t -> int
     (** Returns the number of running domains. *)
     *)
   val num_of_domains : [>`R] t -> int
     (** Returns the number of running domains. *)


@@ -305,7 +321,10 @@ sig
     (** [list_defined_domains conn max]
        returns the names of the inactive domains, up to
        a maximum of [max] entries.
     (** [list_defined_domains conn max]
        returns the names of the inactive domains, up to
        a maximum of [max] entries.

+

        Call {!num_of_defined_domains} first to get a value for [max].
        Call {!num_of_defined_domains} first to get a value for [max].

+
+       See also: {!Libvirt.get_domains}.

     *)
   val num_of_networks : [>`R] t -> int
     (** Returns the number of networks. *)
     *)
   val num_of_networks : [>`R] t -> int
     (** Returns the number of networks. *)


@@ -395,7 +414,7 @@ sig
     | InfoShutdown | InfoShutoff | InfoCrashed
 
   type info = {
     | InfoShutdown | InfoShutoff | InfoCrashed
 
   type info = {

-    state : state;                     (** running state *)
+    state : state;                     (** running state *)

     max_mem : int64;                   (** maximum memory in kilobytes *)
     memory : int64;                    (** memory used in kilobytes *)
     nr_virt_cpu : int;                 (** number of virtual CPUs *)
     max_mem : int64;                   (** maximum memory in kilobytes *)
     memory : int64;                    (** memory used in kilobytes *)
     nr_virt_cpu : int;                 (** number of virtual CPUs *)


@@ -421,6 +440,13 @@ sig
 
   type memory_flag = Virtual
 
 
   type memory_flag = Virtual
 

+  type list_flag =
+    | ListNoState | ListRunning | ListBlocked
+    | ListPaused | ListShutdown | ListShutoff | ListCrashed
+    | ListActive
+    | ListInactive
+    | ListAll
+

   type block_stats = {
     rd_req : int64;
     rd_bytes : int64;
   type block_stats = {
     rd_req : int64;
     rd_bytes : int64;


@@ -445,6 +471,26 @@ sig
        functions.  If you want to peek more than this then you must
        break your request into chunks. *)
 
        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 {!Libvirt.get_domains}
+       which uses 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.
   val create_linux : [>`W] Connect.t -> xml -> rw t
     (** Create a new guest domain (not necessarily a Linux one)
        from the given XML.


@@ -1008,3 +1054,32 @@ exception Not_supported of string
     See also {{:http://libvirt.org/hvsupport.html}http://libvirt.org/hvsupport.html}
 *)
 
     See also {{:http://libvirt.org/hvsupport.html}http://libvirt.org/hvsupport.html}
 *)
 

+(** {3 Utility functions} *)
+
+val map_ignore_errors : ('a -> 'b) -> 'a list -> 'b list
+(** [map_ignore_errors f xs] calls function [f] for each element of [xs].
+
+    This is just like [List.map] except that if [f x] throws a
+    {!Virterror.t} exception, the error is ignored and [f x]
+    is not returned in the final list.
+
+    This function is primarily useful when dealing with domains which
+    might 'disappear' asynchronously from the currently running
+    program.
+*)
+
+val get_domains : ([>`R] as 'a) Connect.t -> ?want_info:bool -> Domain.list_flag list -> 'a Domain.t list * Domain.info list
+  (** Get the active and/or inactive domains using the most
+      efficient method available.
+
+      The two lists returned will have the same length, unless
+      [~want_info] is [false] in which case the info list 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.
+
+      See also:
+      {!Domain.list_all_domains},
+      {!Connect.list_domains},
+      {!Connect.list_defined_domains}.
+  *)

diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index ff69105..4d69bd1 100644 (file)
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -194,6 +194,96 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 #endif
 }
 
 #endif
 }
 

+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRCONNECTLISTALLDOMAINS
+extern int virConnectListAllDomains (virConnectPtr conn,
+                                     virDomainPtr **domains,
+                                     virDomainInfo **infos,
+                                     int stateflags)
+  __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, 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_NOSTATE; break;
+    case 1: flags |= VIR_DOMAIN_LIST_RUNNING; break;
+    case 2: flags |= VIR_DOMAIN_LIST_BLOCKED; break;
+    case 3: flags |= VIR_DOMAIN_LIST_PAUSED; break;
+    case 4: flags |= VIR_DOMAIN_LIST_SHUTDOWN; break;
+    case 5: flags |= VIR_DOMAIN_LIST_SHUTOFF; break;
+    case 6: flags |= VIR_DOMAIN_LIST_CRASHED; break;
+    case 7: flags |= VIR_DOMAIN_LIST_ACTIVE; break;
+    case 8: flags |= VIR_DOMAIN_LIST_INACTIVE; break;
+    case 9: flags |= VIR_DOMAIN_LIST_ALL; break;
+    }
+  }
+
+  WEAK_SYMBOL_CHECK (virConnectListAllDomains);
+  NONBLOCKING (r = virConnectListAllDomains (conn, &domains,
+                                             want_info ? &infos : NULL,
+                                             flags));
+  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)
 {
 CAMLprim value
 ocaml_libvirt_domain_get_id (value domv)
 {

diff --git a/mlvirsh/mlvirsh.ml b/mlvirsh/mlvirsh.ml
index 4c77e7f..9fd3779 100644 (file)
--- a/mlvirsh/mlvirsh.ml
+++ b/mlvirsh/mlvirsh.ml
@@ -302,8 +302,8 @@ let do_command =
     | D.VcpuRunning -> s_"running"
     | D.VcpuBlocked -> s_"blocked"
   in
     | D.VcpuRunning -> s_"running"
     | D.VcpuBlocked -> s_"blocked"
   in

-  let print_domain_array doms =
-    Array.iter (
+  let print_domain_list doms =
+    List.iter (

       fun dom ->
        let id =
          try sprintf "%d" (D.get_id dom)
       fun dom ->
        let id =
          try sprintf "%d" (D.get_id dom)


@@ -576,21 +576,17 @@ let do_command =
       s_"Print the hostname.",
       [];
     "list",
       s_"Print the hostname.",
       [];
     "list",

-      cmd0 print_domain_array
+      cmd0 print_domain_list

        (fun () ->
           let c = get_readonly_connection () in
        (fun () ->
           let c = get_readonly_connection () in

-          let n = C.num_of_domains c in
-          let domids = C.list_domains c n in
-          Array.map (D.lookup_by_id c) domids),
+          fst (Libvirt.get_domains c ~want_info:false [D.ListActive])),

       s_"List the running domains.",
       [];
     "list-defined",
       s_"List the running domains.",
       [];
     "list-defined",

-      cmd0 print_domain_array
+      cmd0 print_domain_list

        (fun () ->
           let c = get_readonly_connection () in
        (fun () ->
           let c = get_readonly_connection () in

-          let n = C.num_of_defined_domains c in
-          let domnames = C.list_defined_domains c n in
-          Array.map (D.lookup_by_name c) domnames),
+          fst (Libvirt.get_domains c ~want_info:false [D.ListInactive])),

       s_"List the defined but not running domains.",
       [];
     "quit",
       s_"List the defined but not running domains.",
       [];
     "quit",