394 lines
13 KiB
Diff
394 lines
13 KiB
Diff
|
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
|
||
|
|
|