From: Lai Jiangshan Date: Wed, 8 Feb 2012 08:59:45 +0000 (+0800) Subject: ocaml-libvirt: add D.get_cpu_stats() API to ocaml-libvirt X-Git-Tag: 0.6.1.1~1 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=c96c3a119b44d3321dddc5e189dcba991aaff677;p=ocaml-libvirt.git ocaml-libvirt: add D.get_cpu_stats() API to ocaml-libvirt Changed from V3: use new virDomainGetCPUStats() libvirt-API. use C code to construct the typed_param list array Signed-off-by: Lai Jiangshan --- diff --git a/.gitignore b/.gitignore index 4a247bb..2b5e4fd 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,7 @@ core.* *.exe *~ libvirt/libvirt_version.ml +examples/get_cpu_stats examples/list_domains examples/node_info virt-ctrl/virt-ctrl diff --git a/MANIFEST b/MANIFEST index 67a1213..919f3de 100644 --- a/MANIFEST +++ b/MANIFEST @@ -8,6 +8,7 @@ configure.ac COPYING COPYING.LIB examples/.depend +examples/get_cpu_stats.ml examples/list_domains.ml examples/node_info.ml examples/Makefile.in diff --git a/Makefile.in b/Makefile.in index 1564c08..99bc82b 100644 --- a/Makefile.in +++ b/Makefile.in @@ -39,6 +39,7 @@ clean: done rm -f examples/list_domains rm -f examples/node_info + rm -f examples/get_cpu_stats distclean: clean rm -f config.h config.log config.status configure diff --git a/config.h.in b/config.h.in index 33e6b61..fccbbe7 100644 --- a/config.h.in +++ b/config.h.in @@ -36,9 +36,6 @@ /* Define to 1 if you have the `virConnectGetURI' function. */ #undef HAVE_VIRCONNECTGETURI -/* Define to 1 if you have the `virConnectListAllDomains' function. */ -#undef HAVE_VIRCONNECTLISTALLDOMAINS - /* Define to 1 if you have the `virConnectListDefinedStoragePools' function. */ #undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS @@ -59,6 +56,9 @@ /* Define to 1 if you have the `virDomainBlockStats' function. */ #undef HAVE_VIRDOMAINBLOCKSTATS +/* Define to 1 if you have the `virDomainGetCPUStats' function. */ +#undef HAVE_VIRDOMAINGETCPUSTATS + /* Define to 1 if you have the `virDomainGetSchedulerParameters' function. */ #undef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS diff --git a/configure.ac b/configure.ac index e6ca675..47b981f 100644 --- a/configure.ac +++ b/configure.ac @@ -125,6 +125,7 @@ AC_CHECK_FUNCS([virConnectGetHostname \ virStorageVolGetPath \ virDomainBlockPeek \ virDomainMemoryPeek \ + virDomainGetCPUStats \ ]) dnl Check for optional types added since 0.2.1. diff --git a/examples/.depend b/examples/.depend index f4053d0..831adf6 100644 --- a/examples/.depend +++ b/examples/.depend @@ -1,4 +1,6 @@ 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 list_domains.cmo: ../libvirt/libvirt.cmi list_domains.cmx: ../libvirt/libvirt.cmx diff --git a/examples/Makefile.in b/examples/Makefile.in index 9bed8ec..2eb220a 100644 --- a/examples/Makefile.in +++ b/examples/Makefile.in @@ -27,7 +27,7 @@ OCAMLOPTLIBS := $(OCAMLCLIBS) export LIBRARY_PATH=../libvirt export LD_LIBRARY_PATH=../libvirt -BYTE_TARGETS := list_domains node_info +BYTE_TARGETS := list_domains node_info get_cpu_stats OPT_TARGETS := $(BYTE_TARGETS:%=%.opt) all: $(BYTE_TARGETS) @@ -54,6 +54,16 @@ node_info.opt: node_info.cmx $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ ../libvirt/mllibvirt.cmxa -o $@ $< +get_cpu_stats: get_cpu_stats.cmo + $(OCAMLFIND) ocamlc \ + $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ + ../libvirt/mllibvirt.cma -o $@ $< + +get_cpu_stats.opt: get_cpu_stats.cmx + $(OCAMLFIND) ocamlopt \ + $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ + ../libvirt/mllibvirt.cmxa -o $@ $< + install-opt install-byte: include ../Make.rules diff --git a/examples/get_cpu_stats.ml b/examples/get_cpu_stats.ml new file mode 100644 index 0000000..79d5c3c --- /dev/null +++ b/examples/get_cpu_stats.ml @@ -0,0 +1,55 @@ +(* List CPU stats for a domain. + * Usage: get_cpu_stats domain + * http://libvirt.org/ + *) + +open Printf + +module C = Libvirt.Connect +module D = Libvirt.Domain +module N = Libvirt.Network + +let () = + try + if Array.length Sys.argv <> 2 then ( + eprintf "error: get_cpu_stats domain\n"; + exit 1 + ); + let domname = Sys.argv.(1) in + + 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 + D.get_cpu_stats dom nr_pcpus in + + Array.iteri ( + fun n params -> + printf "pCPU %d:" n; + List.iter ( + fun (name, value) -> + printf " %s=" name; + 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 + ) params; + printf "\n" + ) stats + with + Libvirt.Virterror err -> + eprintf "error: %s\n" (Libvirt.Virterror.to_string err) + +let () = + (* Run the garbage collector which is a good way to check for + * memory corruption errors and reference counting issues in libvirt. + *) + Gc.compact () diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 9b16650..53c5bb4 100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -341,6 +341,13 @@ struct | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 | SchedFieldFloat of float | SchedFieldBool of bool + type typed_param = string * typed_param_value + and typed_param_value = + | TypedFieldInt32 of int32 | TypedFieldUInt32 of int32 + | TypedFieldInt64 of int64 | TypedFieldUInt64 of int64 + | TypedFieldFloat of float | TypedFieldBool of bool + | TypedFieldString of string + type migrate_flag = Live type memory_flag = Virtual @@ -410,6 +417,7 @@ struct external set_vcpus : [>`W] t -> int -> unit = "ocaml_libvirt_domain_set_vcpus" external pin_vcpu : [>`W] t -> int -> string -> unit = "ocaml_libvirt_domain_pin_vcpu" external get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string = "ocaml_libvirt_domain_get_vcpus" + external get_cpu_stats : [>`R] t -> int -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats" external get_max_vcpus : [>`R] t -> int = "ocaml_libvirt_domain_get_max_vcpus" external attach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_attach_device" external detach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_detach_device" diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index 3d7d95f..0913a63 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -435,6 +435,13 @@ sig | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 | SchedFieldFloat of float | SchedFieldBool of bool + type typed_param = string * typed_param_value + and typed_param_value = + | TypedFieldInt32 of int32 | TypedFieldUInt32 of int32 + | TypedFieldInt64 of int64 | TypedFieldUInt64 of int64 + | TypedFieldFloat of float | TypedFieldBool of bool + | TypedFieldString of string + type migrate_flag = Live type memory_flag = Virtual @@ -552,6 +559,10 @@ sig for a domain. See the libvirt documentation for details of the array and bitmap returned from this function. *) + val get_cpu_stats : [>`R] t -> int -> typed_param list array + (** [get_pcpu_stats dom nr_pcpu] returns the physical CPU stats + for a domain. See the libvirt documentation for details. + *) val get_max_vcpus : [>`R] t -> int (** Returns the maximum number of vCPUs supported for this domain. *) val attach_device : [>`W] t -> xml -> unit diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index 29a1c05..f827707 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -520,6 +520,118 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) } #ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRDOMAINGETCPUSTATS +extern int virDomainGetCPUStats (virDomainPtr domain, + virTypedParameterPtr params, + unsigned int nparams, + int start_cpu, + unsigned int ncpus, + unsigned int flags) + __attribute__((weak)); +#endif +#endif + +CAMLprim value +ocaml_libvirt_domain_get_cpu_stats (value domv, value nr_pcpusv) +{ +#ifdef HAVE_VIRDOMAINGETCPUSTATS + CAMLparam2 (domv, nr_pcpusv); + CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value); + CAMLlocal1 (v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int nr_pcpus = Int_val (nr_pcpusv); + virTypedParameterPtr params; + int r, cpu, ncpus, nparams, i, j, pos; + + /* get percpu information */ + NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, -1, 1, 0)); + CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats"); + + if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL) + caml_failwith ("virDomainGetCPUStats: malloc"); + + cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */ + cpu = 0; + while (cpu < nr_pcpus) { + ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu; + + NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0)); + CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats"); + + for (i = 0; i < ncpus; i++) { + /* list of typed_param: single linked list of param_nodes */ + param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */ + + if (params[i * nparams].type == 0) { + Store_field(cpustats, cpu + i, param_head); + continue; + } + + for (j = nparams - 1; j >= 0; j--) { + pos = i * nparams + j; + if (params[pos].type == 0) + continue; + + param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */ + Store_field(param_node, 1, param_head); + param_head = param_node; + + typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */ + Store_field(param_node, 0, typed_param); + Store_field(typed_param, 0, caml_copy_string(params[pos].field)); + + /* typed_param_value: value with the corresponding type tag */ + switch(params[pos].type) { + case VIR_TYPED_PARAM_INT: + typed_param_value = caml_alloc (1, 0); + v = caml_copy_int32 (params[pos].value.i); + break; + case VIR_TYPED_PARAM_UINT: + typed_param_value = caml_alloc (1, 1); + v = caml_copy_int32 (params[pos].value.ui); + break; + case VIR_TYPED_PARAM_LLONG: + typed_param_value = caml_alloc (1, 2); + v = caml_copy_int64 (params[pos].value.l); + break; + case VIR_TYPED_PARAM_ULLONG: + typed_param_value = caml_alloc (1, 3); + v = caml_copy_int64 (params[pos].value.ul); + break; + case VIR_TYPED_PARAM_DOUBLE: + typed_param_value = caml_alloc (1, 4); + v = caml_copy_double (params[pos].value.d); + break; + case VIR_TYPED_PARAM_BOOLEAN: + typed_param_value = caml_alloc (1, 5); + v = Val_bool (params[pos].value.b); + break; + case VIR_TYPED_PARAM_STRING: + typed_param_value = caml_alloc (1, 6); + v = caml_copy_string (params[pos].value.s); + free (params[pos].value.s); + break; + default: + free (params); + caml_failwith ("virDomainGetCPUStats: " + "unknown parameter type returned"); + } + Store_field (typed_param_value, 0, v); + Store_field (typed_param, 1, typed_param_value); + } + Store_field (cpustats, cpu + i, param_head); + } + cpu += ncpus; + } + free(params); + CAMLreturn (cpustats); +#else + not_supported ("virDomainGetCPUStats"); +#endif +} + +#ifdef HAVE_WEAK_SYMBOLS #ifdef HAVE_VIRDOMAINMIGRATE extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn, unsigned long flags, const char *dname,