From 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd Mon Sep 17 00:00:00 2001

From: "Richard W.M. Jones" <rjones@redhat.com>

Date: Tue, 28 Mar 2017 10:08:06 +0100

Subject: [PATCH 3/5] Add a binding for virConnectGetAllDomainStats

 (RHBZ#1390171).

---

 .gitignore                       |   2 +

 Makefile.in                      |   1 +

 examples/.depend                 |   2 +

 examples/Makefile.in             |  13 ++++-

 examples/get_all_domain_stats.ml |  65 +++++++++++++++++++++

 libvirt/libvirt.ml               |  23 ++++++++

 libvirt/libvirt.mli              |  28 +++++++++

 libvirt/libvirt_c_oneoffs.c      | 119 ++++++++++++++++++++++++++++++++++++++-

 8 files changed, 250 insertions(+), 3 deletions(-)

 create mode 100644 examples/get_all_domain_stats.ml

diff --git a/.gitignore b/.gitignore

index 71a245e..366eb29 100644

--- a/.gitignore

+++ b/.gitignore

@@ -1,3 +1,4 @@

+.gdb_history

 META

 ocaml-libvirt-*.tar.gz

 ocaml-libvirt-*.exe

@@ -27,6 +28,7 @@ core.*

 *~

 libvirt/libvirt_version.ml

 examples/domain_events

+examples/get_all_domain_stats

 examples/get_cpu_stats

 examples/list_domains

 examples/node_info

diff --git a/Makefile.in b/Makefile.in

index 3b8b7ec..2605ddd 100644

--- a/Makefile.in

+++ b/Makefile.in

@@ -41,6 +41,7 @@ clean:

 	rm -f examples/node_info

 	rm -f examples/get_cpu_stats

 	rm -f examples/domain_events

+	rm -f examples/get_all_domain_stats

 distclean: clean

 	rm -f config.h config.log config.status configure

diff --git a/examples/.depend b/examples/.depend

index b5379d8..11f2c7c 100644

--- a/examples/.depend

+++ b/examples/.depend

@@ -1,5 +1,7 @@

 domain_events.cmo : ../libvirt/libvirt.cmi

 domain_events.cmx : ../libvirt/libvirt.cmx

+get_all_domain_stats.cmo : ../libvirt/libvirt.cmi

+get_all_domain_stats.cmx : ../libvirt/libvirt.cmx

 get_cpu_stats.cmo : ../libvirt/libvirt.cmi

 get_cpu_stats.cmx : ../libvirt/libvirt.cmx

 list_domains.cmo : ../libvirt/libvirt.cmi

diff --git a/examples/Makefile.in b/examples/Makefile.in

index 46006a0..8530edc 100644

--- a/examples/Makefile.in

+++ b/examples/Makefile.in

@@ -27,7 +27,8 @@ OCAMLOPTLIBS	:= $(OCAMLCLIBS)

 export LIBRARY_PATH=../libvirt

 export LD_LIBRARY_PATH=../libvirt

-BYTE_TARGETS	:= list_domains node_info get_cpu_stats domain_events

+BYTE_TARGETS	:= list_domains node_info get_cpu_stats \

+		   get_all_domain_stats domain_events

 OPT_TARGETS	:= $(BYTE_TARGETS:%=%.opt)

 all: $(BYTE_TARGETS)

@@ -64,6 +65,16 @@ get_cpu_stats.opt: get_cpu_stats.cmx

 	  $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \

 	  ../libvirt/mllibvirt.cmxa -o $@ $<

+get_all_domain_stats: get_all_domain_stats.cmo

+	$(OCAMLFIND) ocamlc \

+	  $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \

+	  ../libvirt/mllibvirt.cma -o $@ $<

+

+get_all_domain_stats.opt: get_all_domain_stats.cmx

+	$(OCAMLFIND) ocamlopt \

+	  $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \

+	  ../libvirt/mllibvirt.cmxa -o $@ $<

+

 domain_events: domain_events.cmo

 	$(OCAMLFIND) ocamlc \

 	  $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \

diff --git a/examples/get_all_domain_stats.ml b/examples/get_all_domain_stats.ml

new file mode 100644

index 0000000..4375639

--- /dev/null

+++ b/examples/get_all_domain_stats.ml

@@ -0,0 +1,65 @@

+(* Example of using Domain.get_all_domain_stats (virConnectGetAllDomainStats).

+ * Usage: get_all_domain_stats

+ * http://libvirt.org/

+ *)

+

+open Printf

+

+module C = Libvirt.Connect

+module D = Libvirt.Domain

+

+let print_stats stats =

+  try

+    Array.iter (

+      fun { D.dom = dom; D.params = params } ->

+        printf "domain %s:\n" (D.get_name dom);

+        Array.iteri (

+          fun i (field, value) ->

+            printf "\t%-20s = " field;

+            (match value with

+             | D.TypedFieldInt32 i -> printf "%ld" i

+             | D.TypedFieldUInt32 i -> printf "%ld" i

+             | D.TypedFieldInt64 i -> printf "%Ld" i

+             | D.TypedFieldUInt64 i -> printf "%Ld" i

+             | D.TypedFieldFloat f -> printf "%g" f

+             | D.TypedFieldBool b -> printf "%b" b

+             | D.TypedFieldString s -> printf "%S" s);

+            printf "\n";

+        ) params;

+        printf "\n"

+    ) stats

+  with

+    Libvirt.Virterror err ->

+      eprintf "error: %s\n" (Libvirt.Virterror.to_string err)

+

+let () =

+  if Array.length Sys.argv <> 1 then (

+    eprintf "error: get_all_domain_stats\n";

+    exit 1

+  );

+

+  let conn = C.connect_readonly () in

+

+  let what_stats = [D.StatsCpuTotal; D.StatsInterface; D.StatsBlock] in

+  let flags = [D.GetAllDomainsStatsActive; D.GetAllDomainsStatsInactive] in

+

+  let quit = ref false in

+

+  while not !quit do

+    let stats = D.get_all_domain_stats conn what_stats flags in

+

+    if stats <> [||] then print_stats stats

+    else (

+      printf "no guests found\n";

+      quit := true

+    );

+    flush stdout;

+

+    (* Run the garbage collector which is a good way to check for

+     * memory corruption errors and reference counting issues in

+     * libvirt.  You shouldn't do this in ordinary programs.

+     *)

+    Gc.compact ();

+

+    if not !quit then Unix.sleep 3

+  done

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml

index 1be023d..ce1878a 100644

--- a/libvirt/libvirt.ml

+++ b/libvirt/libvirt.ml

@@ -392,6 +392,27 @@ struct

     tx_drop : int64;

   }

+  type get_all_domain_stats_flag =

+    | GetAllDomainsStatsActive

+    | GetAllDomainsStatsInactive

+    | GetAllDomainsStatsOther

+    | GetAllDomainsStatsPaused

+    | GetAllDomainsStatsPersistent

+    | GetAllDomainsStatsRunning

+    | GetAllDomainsStatsShutoff

+    | GetAllDomainsStatsTransient

+    | GetAllDomainsStatsBacking

+    | GetAllDomainsStatsEnforceStats

+

+  type stats_type =

+    | StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu

+    | StatsInterface | StatsBlock | StatsPerf

+

+  type 'a domain_stats_record = {

+    dom : 'a t;

+    params : typed_param array;

+  }

+

   (* 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.

@@ -446,6 +467,8 @@ struct

   external block_peek : [>`W] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native"

   external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native"

+  external get_all_domain_stats : 'a Connect.t -> stats_type list -> get_all_domain_stats_flag list -> 'a domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"

+

   external const : [>`R] t -> ro t = "%identity"

   let get_domains conn flags =

diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli

index 8cfcae2..d1b5992 100644

--- a/libvirt/libvirt.mli

+++ b/libvirt/libvirt.mli

@@ -478,6 +478,27 @@ sig

     tx_drop : int64;

   }

+  type get_all_domain_stats_flag =

+    | GetAllDomainsStatsActive

+    | GetAllDomainsStatsInactive

+    | GetAllDomainsStatsOther

+    | GetAllDomainsStatsPaused

+    | GetAllDomainsStatsPersistent

+    | GetAllDomainsStatsRunning

+    | GetAllDomainsStatsShutoff

+    | GetAllDomainsStatsTransient

+    | GetAllDomainsStatsBacking

+    | GetAllDomainsStatsEnforceStats

+

+  type stats_type =

+    | StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu

+    | StatsInterface | StatsBlock | StatsPerf

+

+  type 'a domain_stats_record = {

+    dom : 'a t;

+    params : typed_param array;

+  }

+

   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

@@ -615,6 +636,13 @@ sig

 	See also {!max_peek}. *)

+  external get_all_domain_stats : 'a Connect.t -> stats_type list -> get_all_domain_stats_flag list -> 'a domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"

+    (** [get_all_domain_stats conn stats flags] allows you to read

+        all stats across multiple/all domains in a single call.

+

+        See the libvirt documentation for

+        [virConnectGetAllDomainStats]. *)

+

   external const : [>`R] t -> ro t = "%identity"

     (** [const dom] turns a read/write domain handle into a read-only

 	domain handle.  Note that the opposite operation is impossible.

diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c

index 5d82194..17412f5 100644

--- a/libvirt/libvirt_c_oneoffs.c

+++ b/libvirt/libvirt_c_oneoffs.c

@@ -1,5 +1,5 @@

 /* OCaml bindings for libvirt.

- * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.

+ * (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.

  * http://libvirt.org/

  *

  * This library is free software; you can redistribute it and/or

@@ -184,7 +184,6 @@ ocaml_libvirt_connect_set_keep_alive(value connv,

   CAMLreturn(Val_unit);

 }

-

 CAMLprim value

 ocaml_libvirt_domain_get_id (value domv)

 {

@@ -560,6 +559,122 @@ ocaml_libvirt_domain_get_cpu_stats (value domv)

   CAMLreturn (cpustats);

 }

+value

+ocaml_libvirt_domain_get_all_domain_stats (value connv,

+                                           value statsv, value flagsv)

+{

+  CAMLparam3 (connv, statsv, flagsv);

+  CAMLlocal5 (rv, dsv, tpv, v, v1);

+  CAMLlocal1 (v2);

+  virConnectPtr conn = Connect_val (connv);

+  virDomainStatsRecordPtr *rstats;

+  unsigned int stats = 0, flags = 0;

+  int i, j, r;

+

+  /* Get stats and flags. */

+  for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {

+    v = Field (statsv, 0);

+    if (v == Val_int (0))

+      stats |= VIR_DOMAIN_STATS_STATE;

+    else if (v == Val_int (1))

+      stats |= VIR_DOMAIN_STATS_CPU_TOTAL;

+    else if (v == Val_int (2))

+      stats |= VIR_DOMAIN_STATS_BALLOON;

+    else if (v == Val_int (3))

+      stats |= VIR_DOMAIN_STATS_VCPU;

+    else if (v == Val_int (4))

+      stats |= VIR_DOMAIN_STATS_INTERFACE;

+    else if (v == Val_int (5))

+      stats |= VIR_DOMAIN_STATS_BLOCK;

+    else if (v == Val_int (6))

+      stats |= VIR_DOMAIN_STATS_PERF;

+  }

+  for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {

+    v = Field (flagsv, 0);

+    if (v == Val_int (0))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ACTIVE;

+    else if (v == Val_int (1))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_INACTIVE;

+    else if (v == Val_int (2))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_OTHER;

+    else if (v == Val_int (3))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PAUSED;

+    else if (v == Val_int (4))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PERSISTENT;

+    else if (v == Val_int (5))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_RUNNING;

+    else if (v == Val_int (6))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_SHUTOFF;

+    else if (v == Val_int (7))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_TRANSIENT;

+    else if (v == Val_int (8))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_BACKING;

+    else if (v == Val_int (9))

+      flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ENFORCE_STATS;

+  }

+

+  NONBLOCKING (r = virConnectGetAllDomainStats (conn, stats, &rstats, flags));

+  CHECK_ERROR (r == -1, "virConnectGetAllDomainStats");

+

+  rv = caml_alloc (r, 0);       /* domain_stats_record array. */

+  for (i = 0; i < r; ++i) {

+    dsv = caml_alloc (2, 0);    /* domain_stats_record */

+    virDomainRef (rstats[i]->dom);

+    Store_field (dsv, 0, Val_domain (rstats[i]->dom, connv));

+

+    tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */

+    for (j = 0; j < rstats[i]->nparams; ++j) {

+      v2 = caml_alloc (2, 0);   /* typed_param: field name, value */

+      Store_field (v2, 0, caml_copy_string (rstats[i]->params[j].field));

+

+      switch (rstats[i]->params[j].type) {

+      case VIR_TYPED_PARAM_INT:

+        v1 = caml_alloc (1, 0);

+        v = caml_copy_int32 (rstats[i]->params[j].value.i);

+        break;

+      case VIR_TYPED_PARAM_UINT:

+        v1 = caml_alloc (1, 1);

+        v = caml_copy_int32 (rstats[i]->params[j].value.ui);

+        break;

+      case VIR_TYPED_PARAM_LLONG:

+        v1 = caml_alloc (1, 2);

+        v = caml_copy_int64 (rstats[i]->params[j].value.l);

+        break;

+      case VIR_TYPED_PARAM_ULLONG:

+        v1 = caml_alloc (1, 3);

+        v = caml_copy_int64 (rstats[i]->params[j].value.ul);

+        break;

+      case VIR_TYPED_PARAM_DOUBLE:

+        v1 = caml_alloc (1, 4);

+        v = caml_copy_double (rstats[i]->params[j].value.d);

+        break;

+      case VIR_TYPED_PARAM_BOOLEAN:

+        v1 = caml_alloc (1, 5);

+        v = Val_bool (rstats[i]->params[j].value.b);

+        break;

+      case VIR_TYPED_PARAM_STRING:

+        v1 = caml_alloc (1, 6);

+        v = caml_copy_string (rstats[i]->params[j].value.s);

+        break;

+      default:

+        virDomainStatsRecordListFree (rstats);

+        caml_failwith ("virConnectGetAllDomainStats: "

+                       "unknown parameter type returned");

+      }

+      Store_field (v1, 0, v);

+

+      Store_field (v2, 1, v1);

+      Store_field (tpv, j, v2);

+    }

+

+    Store_field (dsv, 1, tpv);

+    Store_field (rv, i, dsv);

+  }

+

+  virDomainStatsRecordListFree (rstats);

+  CAMLreturn (rv);

+}

+

 CAMLprim value

 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)

 {

-- 

2.9.3