From 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" 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