testing/ocaml-libvirt: new aport

http://libvirt.org/ocaml/
OCaml binding for libvirt

1 files changed, 393 insertions, 0 deletions

diff --git a/testing/ocaml-libvirt/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch b/testing/ocaml-libvirt/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch
new file mode 100644
index 0000000000..0eb1b28eef
--- /dev/null
+++ b/testing/ocaml-libvirt/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" <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
+