Further upstream patches, adding binding for virConnectGetAllDomainStats.
This commit is contained in:
parent
a771cbebce
commit
2dea13d3c3
78
0001-Use-g-warn-error.patch
Normal file
78
0001-Use-g-warn-error.patch
Normal file
@ -0,0 +1,78 @@
|
||||
From 2ba6898b4dc121b00078e36d5416b3caadd5d05e Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Mon, 27 Mar 2017 14:12:50 +0100
|
||||
Subject: [PATCH 1/5] Use -g -warn-error.
|
||||
|
||||
Use -g for ocamlopt. ocamlopt has supported generating DWARF
|
||||
information for quite a long time.
|
||||
|
||||
Also use -warn-error with the same set of warnings as is used
|
||||
by libguestfs.
|
||||
|
||||
Fix a warning in examples/get_cpu_stats.ml found by enabling
|
||||
-warn-error.
|
||||
---
|
||||
examples/Makefile.in | 4 ++--
|
||||
examples/get_cpu_stats.ml | 2 ++
|
||||
libvirt/Makefile.in | 6 +++---
|
||||
3 files changed, 7 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/examples/Makefile.in b/examples/Makefile.in
|
||||
index 041e382..46006a0 100644
|
||||
--- a/examples/Makefile.in
|
||||
+++ b/examples/Makefile.in
|
||||
@@ -18,10 +18,10 @@
|
||||
OCAMLFIND = @OCAMLFIND@
|
||||
|
||||
OCAMLCPACKAGES := -package unix -I ../libvirt
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := -linkpkg
|
||||
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
|
||||
-OCAMLOPTFLAGS :=
|
||||
+OCAMLOPTFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLOPTLIBS := $(OCAMLCLIBS)
|
||||
|
||||
export LIBRARY_PATH=../libvirt
|
||||
diff --git a/examples/get_cpu_stats.ml b/examples/get_cpu_stats.ml
|
||||
index d7a8d0c..814c85e 100644
|
||||
--- a/examples/get_cpu_stats.ml
|
||||
+++ b/examples/get_cpu_stats.ml
|
||||
@@ -19,9 +19,11 @@ let () =
|
||||
|
||||
let conn = C.connect_readonly () in
|
||||
|
||||
+ (*
|
||||
let nr_pcpus =
|
||||
let info = C.get_node_info conn in
|
||||
C.maxcpus_of_node_info info in
|
||||
+ *)
|
||||
|
||||
let stats =
|
||||
let dom = D.lookup_by_name conn domname in
|
||||
diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in
|
||||
index f7c04bb..cf614fc 100644
|
||||
--- a/libvirt/Makefile.in
|
||||
+++ b/libvirt/Makefile.in
|
||||
@@ -31,15 +31,15 @@ OCAMLMKLIB = @OCAMLMKLIB@
|
||||
|
||||
ifneq ($(OCAMLFIND),)
|
||||
OCAMLCPACKAGES := -package unix
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := -linkpkg
|
||||
else
|
||||
OCAMLCINCS :=
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := unix.cma
|
||||
endif
|
||||
|
||||
-OCAMLOPTFLAGS :=
|
||||
+OCAMLOPTFLAGS := $(OCAMLCFLAGS)
|
||||
ifneq ($(OCAMLFIND),)
|
||||
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
|
||||
OCAMLOPTLIBS := $(OCAMLCLIBS)
|
||||
--
|
||||
2.9.3
|
||||
|
44
0002-Update-dependencies.patch
Normal file
44
0002-Update-dependencies.patch
Normal file
@ -0,0 +1,44 @@
|
||||
From ca9a3227f9937f9cdeb84126f1c74502c9a25047 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Mon, 27 Mar 2017 14:13:47 +0100
|
||||
Subject: [PATCH 2/5] Update dependencies.
|
||||
|
||||
---
|
||||
examples/.depend | 8 ++++----
|
||||
libvirt/.depend | 6 +++---
|
||||
2 files changed, 7 insertions(+), 7 deletions(-)
|
||||
|
||||
diff --git a/examples/.depend b/examples/.depend
|
||||
index b305b76..b5379d8 100644
|
||||
--- a/examples/.depend
|
||||
+++ b/examples/.depend
|
||||
@@ -1,8 +1,8 @@
|
||||
-node_info.cmo : ../libvirt/libvirt.cmi
|
||||
-node_info.cmx : ../libvirt/libvirt.cmx
|
||||
-get_cpu_stats.cmo : ../libvirt/libvirt.cmi
|
||||
-get_cpu_stats.cmx : ../libvirt/libvirt.cmx
|
||||
domain_events.cmo : ../libvirt/libvirt.cmi
|
||||
domain_events.cmx : ../libvirt/libvirt.cmx
|
||||
+get_cpu_stats.cmo : ../libvirt/libvirt.cmi
|
||||
+get_cpu_stats.cmx : ../libvirt/libvirt.cmx
|
||||
list_domains.cmo : ../libvirt/libvirt.cmi
|
||||
list_domains.cmx : ../libvirt/libvirt.cmx
|
||||
+node_info.cmo : ../libvirt/libvirt.cmi
|
||||
+node_info.cmx : ../libvirt/libvirt.cmx
|
||||
diff --git a/libvirt/.depend b/libvirt/.depend
|
||||
index 7d32e13..ee1180c 100644
|
||||
--- a/libvirt/.depend
|
||||
+++ b/libvirt/.depend
|
||||
@@ -1,6 +1,6 @@
|
||||
-libvirt_version.cmi :
|
||||
+libvirt.cmo : libvirt.cmi
|
||||
+libvirt.cmx : libvirt.cmi
|
||||
libvirt.cmi :
|
||||
libvirt_version.cmo : libvirt_version.cmi
|
||||
libvirt_version.cmx : libvirt_version.cmi
|
||||
-libvirt.cmo : libvirt.cmi
|
||||
-libvirt.cmx : libvirt.cmi
|
||||
+libvirt_version.cmi :
|
||||
--
|
||||
2.9.3
|
||||
|
393
0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch
Normal file
393
0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch
Normal file
@ -0,0 +1,393 @@
|
||||
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
|
||||
|
@ -0,0 +1,42 @@
|
||||
From 2bb6200934090f34f81d1badb9a55f5a86a7fb32 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Tue, 28 Mar 2017 13:11:09 +0100
|
||||
Subject: [PATCH 4/5] examples: Print more stats in the get_all_domain_stats.ml
|
||||
example.
|
||||
|
||||
Updates commit 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd.
|
||||
---
|
||||
examples/get_all_domain_stats.ml | 13 ++++++++++---
|
||||
1 file changed, 10 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/examples/get_all_domain_stats.ml b/examples/get_all_domain_stats.ml
|
||||
index 4375639..cc86da6 100644
|
||||
--- a/examples/get_all_domain_stats.ml
|
||||
+++ b/examples/get_all_domain_stats.ml
|
||||
@@ -40,13 +40,20 @@ let () =
|
||||
|
||||
let conn = C.connect_readonly () in
|
||||
|
||||
- let what_stats = [D.StatsCpuTotal; D.StatsInterface; D.StatsBlock] in
|
||||
- let flags = [D.GetAllDomainsStatsActive; D.GetAllDomainsStatsInactive] in
|
||||
+ let what = [
|
||||
+ D.StatsState;
|
||||
+ D.StatsCpuTotal;
|
||||
+ D.StatsBalloon;
|
||||
+ D.StatsVcpu;
|
||||
+ D.StatsInterface;
|
||||
+ D.StatsBlock;
|
||||
+ ] in
|
||||
+ let who = [] in (* empty list means returns all domains *)
|
||||
|
||||
let quit = ref false in
|
||||
|
||||
while not !quit do
|
||||
- let stats = D.get_all_domain_stats conn what_stats flags in
|
||||
+ let stats = D.get_all_domain_stats conn what who in
|
||||
|
||||
if stats <> [||] then print_stats stats
|
||||
else (
|
||||
--
|
||||
2.9.3
|
||||
|
127
0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch
Normal file
127
0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch
Normal file
@ -0,0 +1,127 @@
|
||||
From 3169af3337938e18bf9ecc6ce936d644e14ff3de Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Tue, 28 Mar 2017 13:52:51 +0100
|
||||
Subject: [PATCH 5/5] Change binding of virConnectGetAllDomainStats to return
|
||||
dom UUID.
|
||||
|
||||
The virDomainPtr object returned by this binding isn't a reliable
|
||||
virDomainPtr object. The only thing we can safely do with it is to
|
||||
get its UUID. Modify the API correspondingly.
|
||||
|
||||
Updates commit 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd.
|
||||
---
|
||||
examples/get_all_domain_stats.ml | 7 ++++---
|
||||
libvirt/libvirt.ml | 6 +++---
|
||||
libvirt/libvirt.mli | 6 +++---
|
||||
libvirt/libvirt_c_oneoffs.c | 13 +++++++++++--
|
||||
4 files changed, 21 insertions(+), 11 deletions(-)
|
||||
|
||||
diff --git a/examples/get_all_domain_stats.ml b/examples/get_all_domain_stats.ml
|
||||
index cc86da6..be91f77 100644
|
||||
--- a/examples/get_all_domain_stats.ml
|
||||
+++ b/examples/get_all_domain_stats.ml
|
||||
@@ -8,10 +8,11 @@ open Printf
|
||||
module C = Libvirt.Connect
|
||||
module D = Libvirt.Domain
|
||||
|
||||
-let print_stats stats =
|
||||
+let print_stats conn stats =
|
||||
try
|
||||
Array.iter (
|
||||
- fun { D.dom = dom; D.params = params } ->
|
||||
+ fun { D.dom_uuid = uuid; D.params = params } ->
|
||||
+ let dom = D.lookup_by_uuid conn uuid in
|
||||
printf "domain %s:\n" (D.get_name dom);
|
||||
Array.iteri (
|
||||
fun i (field, value) ->
|
||||
@@ -55,7 +56,7 @@ let () =
|
||||
while not !quit do
|
||||
let stats = D.get_all_domain_stats conn what who in
|
||||
|
||||
- if stats <> [||] then print_stats stats
|
||||
+ if stats <> [||] then print_stats conn stats
|
||||
else (
|
||||
printf "no guests found\n";
|
||||
quit := true
|
||||
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
|
||||
index ce1878a..d03a127 100644
|
||||
--- a/libvirt/libvirt.ml
|
||||
+++ b/libvirt/libvirt.ml
|
||||
@@ -408,8 +408,8 @@ struct
|
||||
| StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu
|
||||
| StatsInterface | StatsBlock | StatsPerf
|
||||
|
||||
- type 'a domain_stats_record = {
|
||||
- dom : 'a t;
|
||||
+ type domain_stats_record = {
|
||||
+ dom_uuid : uuid;
|
||||
params : typed_param array;
|
||||
}
|
||||
|
||||
@@ -467,7 +467,7 @@ 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 get_all_domain_stats : [>`R] Connect.t -> stats_type list -> get_all_domain_stats_flag list -> domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"
|
||||
|
||||
external const : [>`R] t -> ro t = "%identity"
|
||||
|
||||
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
|
||||
index d1b5992..dc0033b 100644
|
||||
--- a/libvirt/libvirt.mli
|
||||
+++ b/libvirt/libvirt.mli
|
||||
@@ -494,8 +494,8 @@ sig
|
||||
| StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu
|
||||
| StatsInterface | StatsBlock | StatsPerf
|
||||
|
||||
- type 'a domain_stats_record = {
|
||||
- dom : 'a t;
|
||||
+ type domain_stats_record = {
|
||||
+ dom_uuid : uuid;
|
||||
params : typed_param array;
|
||||
}
|
||||
|
||||
@@ -636,7 +636,7 @@ 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"
|
||||
+ external get_all_domain_stats : [>`R] Connect.t -> stats_type list -> get_all_domain_stats_flag list -> 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.
|
||||
|
||||
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
|
||||
index 17412f5..958ba69 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -570,6 +570,7 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
|
||||
virDomainStatsRecordPtr *rstats;
|
||||
unsigned int stats = 0, flags = 0;
|
||||
int i, j, r;
|
||||
+ unsigned char uuid[VIR_UUID_BUFLEN];
|
||||
|
||||
/* Get stats and flags. */
|
||||
for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
|
||||
@@ -619,8 +620,16 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
|
||||
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));
|
||||
+
|
||||
+ /* Libvirt returns something superficially resembling a
|
||||
+ * virDomainPtr, but it's not a real virDomainPtr object
|
||||
+ * (eg. dom->id == -1, and its refcount is wrong). The only thing
|
||||
+ * we can safely get from it is the UUID.
|
||||
+ */
|
||||
+ v = caml_alloc_string (VIR_UUID_BUFLEN);
|
||||
+ virDomainGetUUID (rstats[i]->dom, uuid);
|
||||
+ memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
|
||||
+ Store_field (dsv, 0, v);
|
||||
|
||||
tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
|
||||
for (j = 0; j < rstats[i]->nparams; ++j) {
|
||||
--
|
||||
2.9.3
|
||||
|
@ -2,7 +2,7 @@
|
||||
|
||||
Name: ocaml-libvirt
|
||||
Version: 0.6.1.4
|
||||
Release: 14%{?dist}
|
||||
Release: 15%{?dist}
|
||||
Summary: OCaml binding for libvirt
|
||||
License: LGPLv2+
|
||||
|
||||
@ -22,6 +22,15 @@ Patch4: 0002-Don-t-bother-checking-return-from-virInitialize.patch
|
||||
# Upstream patch to remove unused function.
|
||||
Patch5: 0001-Remove-unused-not_supported-function.patch
|
||||
|
||||
# Upstream patches to tidy up warnings.
|
||||
Patch6: 0001-Use-g-warn-error.patch
|
||||
Patch7: 0002-Update-dependencies.patch
|
||||
|
||||
# Upstream patches to add binding for virConnectGetAllDomainStats.
|
||||
Patch8: 0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch
|
||||
Patch9: 0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch
|
||||
Patch10: 0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch
|
||||
|
||||
BuildRequires: ocaml >= 3.10.0
|
||||
BuildRequires: ocaml-ocamldoc
|
||||
BuildRequires: ocaml-findlib-devel
|
||||
@ -53,6 +62,11 @@ developing applications that use %{name}.
|
||||
%patch3 -p1
|
||||
%patch4 -p1
|
||||
%patch5 -p1
|
||||
%patch6 -p1
|
||||
%patch7 -p1
|
||||
%patch8 -p1
|
||||
%patch9 -p1
|
||||
%patch10 -p1
|
||||
|
||||
|
||||
%build
|
||||
@ -100,6 +114,9 @@ make install-byte
|
||||
|
||||
|
||||
%changelog
|
||||
* Tue Mar 28 2017 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-15
|
||||
- Further upstream patches, adding binding for virConnectGetAllDomainStats.
|
||||
|
||||
* Sat Feb 11 2017 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.4-14
|
||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_26_Mass_Rebuild
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user