From 2dea13d3c3b08ce25c43b2f548c6d57d773fad56 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 28 Mar 2017 13:15:28 +0100 Subject: [PATCH] Further upstream patches, adding binding for virConnectGetAllDomainStats. --- 0001-Use-g-warn-error.patch | 78 ++++ 0002-Update-dependencies.patch | 44 ++ ...r-virConnectGetAllDomainStats-RHBZ-1.patch | 393 ++++++++++++++++++ ...ore-stats-in-the-get_all_domain_stat.patch | 42 ++ ...f-virConnectGetAllDomainStats-to-ret.patch | 127 ++++++ ocaml-libvirt.spec | 19 +- 6 files changed, 702 insertions(+), 1 deletion(-) create mode 100644 0001-Use-g-warn-error.patch create mode 100644 0002-Update-dependencies.patch create mode 100644 0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch create mode 100644 0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch create mode 100644 0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch diff --git a/0001-Use-g-warn-error.patch b/0001-Use-g-warn-error.patch new file mode 100644 index 0000000..7c6bf35 --- /dev/null +++ b/0001-Use-g-warn-error.patch @@ -0,0 +1,78 @@ +From 2ba6898b4dc121b00078e36d5416b3caadd5d05e Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +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 + diff --git a/0002-Update-dependencies.patch b/0002-Update-dependencies.patch new file mode 100644 index 0000000..1ba95ea --- /dev/null +++ b/0002-Update-dependencies.patch @@ -0,0 +1,44 @@ +From ca9a3227f9937f9cdeb84126f1c74502c9a25047 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +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 + diff --git a/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch b/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch new file mode 100644 index 0000000..0eb1b28 --- /dev/null +++ b/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch @@ -0,0 +1,393 @@ +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 + diff --git a/0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch b/0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch new file mode 100644 index 0000000..a4baded --- /dev/null +++ b/0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch @@ -0,0 +1,42 @@ +From 2bb6200934090f34f81d1badb9a55f5a86a7fb32 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +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 + diff --git a/0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch b/0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch new file mode 100644 index 0000000..955a4ca --- /dev/null +++ b/0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch @@ -0,0 +1,127 @@ +From 3169af3337938e18bf9ecc6ce936d644e14ff3de Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +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 + diff --git a/ocaml-libvirt.spec b/ocaml-libvirt.spec index 9e0394c..9bedbf9 100644 --- a/ocaml-libvirt.spec +++ b/ocaml-libvirt.spec @@ -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 - 0.6.1.4-15 +- Further upstream patches, adding binding for virConnectGetAllDomainStats. + * Sat Feb 11 2017 Fedora Release Engineering - 0.6.1.4-14 - Rebuilt for https://fedoraproject.org/wiki/Fedora_26_Mass_Rebuild