Commit 652f883f authored by Richard W.M. Jones's avatar Richard W.M. Jones

Add a binding for virConnectGetAllDomainStats (RHBZ#1390171).

parent f513bae3
.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
......
......@@ -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
......
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
......
......@@ -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) \
......
(* 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
......@@ -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 =
......
......@@ -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.
......
/* 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)
{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment