rpms/ocaml-libvirt
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Compare commits

merge into: rpms:c8
Branches Tags
rpms:c8
rpms:c10s
rpms:c8s
rpms:c9
rpms:c9-beta
rpms:c9s
rpms:imports/c10s/ocaml-libvirt-0.6.1.7-13.el10
rpms:imports/c10s/ocaml-libvirt-0.6.1.7-12.el10
rpms:imports/c9/ocaml-libvirt-0.6.1.5-19.el9
rpms:imports/c9-beta/ocaml-libvirt-0.6.1.5-19.el9
rpms:imports/c8/ocaml-libvirt-0.6.1.4-29.el8
...
pull from: rpms:c10s
Branches Tags
rpms:c10s
rpms:c8s
rpms:c9
rpms:c9-beta
rpms:c9s
rpms:c8
rpms:imports/c10s/ocaml-libvirt-0.6.1.7-13.el10
rpms:imports/c10s/ocaml-libvirt-0.6.1.7-12.el10
rpms:imports/c9/ocaml-libvirt-0.6.1.5-19.el9
rpms:imports/c9-beta/ocaml-libvirt-0.6.1.5-19.el9
rpms:imports/c8/ocaml-libvirt-0.6.1.4-29.el8

No commits in common. "c8" and "c10s" have entirely different histories.
c8 ... c10s

18 changed files with 207 additions and 3023 deletions
Show Stats Expand all files Collapse all files

4
.gitignore vendored
View File

@ -1 +1,3 @@
SOURCES/ocaml-libvirt-0.6.1.4.tar.gz
/.build*.log
/clog
/ocaml-libvirt-*.tar.gz

1
.ocaml-libvirt.metadata
View File

@ -1 +0,0 @@
013e00c4e32c7d40fae0d0b4750730f6513f9e17 SOURCES/ocaml-libvirt-0.6.1.4.tar.gz

213
SOURCES/0001-Add-a-binding-for-virDomainCreateXML.patch
View File

@ -1,213 +0,0 @@
From 7483c7454538584a3dbe4582096f058e6e877df6 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Fri, 6 Mar 2015 15:35:46 +0000
Subject: [PATCH] Add a binding for virDomainCreateXML.
This is more modern than the ancient virDomainCreateLinux API,
and crucially allows you to pass flags such as AUTODESTROY.
---
configure.ac | 2 +-
libvirt/generator.pl | 23 +++++++++++++++++++++--
libvirt/libvirt.ml | 19 ++++++++++++++++++-
libvirt/libvirt.mli | 13 +++++++++++--
libvirt/libvirt_c.c | 25 ++++++++++++++++++++++++-
5 files changed, 75 insertions(+), 7 deletions(-)
diff --git a/configure.ac b/configure.ac
index b7544b4..a719fb3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
# ocaml-libvirt
-# Copyright (C) 2007-2008 Red Hat Inc., Richard W.M. Jones
+# Copyright (C) 2007-2015 Red Hat Inc., Richard W.M. Jones
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
diff --git a/libvirt/generator.pl b/libvirt/generator.pl
index 8229ad1..421592b 100755
--- a/libvirt/generator.pl
+++ b/libvirt/generator.pl
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
#
# OCaml bindings for libvirt.
-# (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
+# (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
# http://libvirt.org/
#
# This library is free software; you can redistribute it and/or
@@ -63,6 +63,7 @@ my @functions = (
sig => "conn, int : unit" },
{ name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
+ { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" },
{ name => "virDomainFree", sig => "dom : free" },
{ name => "virDomainDestroy", sig => "dom : free" },
{ name => "virDomainLookupByName", sig => "conn, string : dom" },
@@ -198,7 +199,7 @@ print F <<'END';
*/
/* OCaml bindings for libvirt.
- * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
+ * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
* http://libvirt.org/
*
* This library is free software; you can redistribute it and/or
@@ -310,6 +311,8 @@ sub gen_arg_names
( "$1v", "strv" )
} elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
( "$1v", "strv" )
+ } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
+ ( "$1v", "strv", "uv" )
} elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
( "$1v", "iv" )
} elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
@@ -632,6 +635,22 @@ sub gen_c_code
CAMLreturn (rv);
"
+ } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
+ my $c_ret_type = short_name_to_c_type ($2);
+ "\
+ CAMLlocal1 (rv);
+ " . gen_unpack_args ($1) . "
+ char *str = String_val (strv);
+ unsigned int u = Int_val (uv);
+ $c_ret_type r;
+
+ NONBLOCKING (r = $c_name ($1, str, u));
+ CHECK_ERROR (!r, conn, \"$c_name\");
+
+ " . gen_pack_result ($2) . "
+
+ CAMLreturn (rv);
+"
} elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
my $unsigned = $2 eq "u" ? "unsigned " : "";
"\
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index 9c9368a..1be023d 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -1,5 +1,5 @@
(* OCaml bindings for libvirt.
- (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
+ (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
http://libvirt.org/
This library is free software; you can redistribute it and/or
@@ -337,6 +337,20 @@ struct
cpu : int;
}
+ type domain_create_flag =
+ | START_PAUSED
+ | START_AUTODESTROY
+ | START_BYPASS_CACHE
+ | START_FORCE_BOOT
+ | START_VALIDATE
+ let rec int_of_domain_create_flags = function
+ | [] -> 0
+ | START_PAUSED :: flags -> 1 lor int_of_domain_create_flags flags
+ | START_AUTODESTROY :: flags -> 2 lor int_of_domain_create_flags flags
+ | START_BYPASS_CACHE :: flags -> 4 lor int_of_domain_create_flags flags
+ | START_FORCE_BOOT :: flags -> 8 lor int_of_domain_create_flags flags
+ | START_VALIDATE :: flags -> 16 lor int_of_domain_create_flags flags
+
type sched_param = string * sched_param_value
and sched_param_value =
| SchedFieldInt32 of int32 | SchedFieldUInt32 of int32
@@ -385,6 +399,9 @@ struct
let max_peek _ = 65536
external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux"
+ external _create_xml : [>`W] Connect.t -> xml -> int -> rw t = "ocaml_libvirt_domain_create_xml"
+ let create_xml conn xml flags =
+ _create_xml conn xml (int_of_domain_create_flags flags)
external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id"
external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid"
external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string"
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index 36cd113..8cfcae2 100644
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -1,5 +1,5 @@
(** OCaml bindings for libvirt. *)
-(* (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
+(* (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
http://libvirt.org/
This library is free software; you can redistribute it and/or
@@ -430,6 +430,13 @@ sig
cpu : int; (** real CPU number, -1 if offline *)
}
+ type domain_create_flag =
+ | START_PAUSED (** Launch guest in paused state *)
+ | START_AUTODESTROY (** Automatically kill guest on close *)
+ | START_BYPASS_CACHE (** Avoid filesystem cache pollution *)
+ | START_FORCE_BOOT (** Discard any managed save *)
+ | START_VALIDATE (** Validate XML against schema *)
+
type sched_param = string * sched_param_value
and sched_param_value =
| SchedFieldInt32 of int32 | SchedFieldUInt32 of int32
@@ -478,8 +485,10 @@ sig
val create_linux : [>`W] Connect.t -> xml -> rw t
(** Create a new guest domain (not necessarily a Linux one)
- from the given XML.
+ from the given XML. Use {!create_xml} instead.
*)
+ val create_xml : [>`W] Connect.t -> xml -> domain_create_flag list -> rw t
+ (** Create a new guest domain from the given XML. *)
val lookup_by_id : 'a Connect.t -> int -> 'a t
(** Lookup a domain by ID. *)
val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t
diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c
index 71e6f61..6e56682 100644
--- a/libvirt/libvirt_c.c
+++ b/libvirt/libvirt_c.c
@@ -6,7 +6,7 @@
*/
/* OCaml bindings for libvirt.
- * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
+ * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
* http://libvirt.org/
*
* This library is free software; you can redistribute it and/or
@@ -525,6 +525,29 @@ ocaml_libvirt_domain_create_linux (value connv, value strv)
CAMLreturn (rv);
}
+/* Automatically generated binding for virDomainCreateXML.
+ * In generator.pl this function has signature "conn, string, unsigned : dom".
+ */
+
+CAMLprim value
+ocaml_libvirt_domain_create_xml (value connv, value strv, value uv)
+{
+ CAMLparam3 (connv, strv, uv);
+
+ CAMLlocal1 (rv);
+ virConnectPtr conn = Connect_val (connv);
+ char *str = String_val (strv);
+ unsigned int u = Int_val (uv);
+ virDomainPtr r;
+
+ NONBLOCKING (r = virDomainCreateXML (conn, str, u));
+ CHECK_ERROR (!r, conn, "virDomainCreateXML");
+
+ rv = Val_domain (r, connv);
+
+ CAMLreturn (rv);
+}
+
/* Automatically generated binding for virDomainFree.
* In generator.pl this function has signature "dom : free".
*/
--
2.3.1

57
SOURCES/0001-Remove-unused-not_supported-function.patch
View File

@ -1,57 +0,0 @@
From 8853f5a49587f00a7d2a5c8c7e52480a16bbdb02 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Fri, 5 Feb 2016 16:28:34 +0000
Subject: [PATCH] Remove unused 'not_supported' function.
Found by compiling under GCC 6. The warning was:
In file included from libvirt_c.c:2058:0:
libvirt_c_epilogue.c:89:1: error: 'not_supported' defined but not used [-Werror=unused-function]
not_supported (const char *fn)
^~~~~~~~~~~~~
---
libvirt/libvirt_c_epilogue.c | 15 ---------------
libvirt/libvirt_c_prologue.c | 1 -
2 files changed, 16 deletions(-)
diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c
index 4972e50..fa592c9 100644
--- a/libvirt/libvirt_c_epilogue.c
+++ b/libvirt/libvirt_c_epilogue.c
@@ -84,21 +84,6 @@ _raise_virterror (const char *fn)
(void) caml__frame;
}
-/* Raise an error if a function is not supported. */
-static void
-not_supported (const char *fn)
-{
- CAMLparam0 ();
- CAMLlocal1 (fnv);
-
- fnv = caml_copy_string (fn);
- caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv);
-
- /*NOTREACHED*/
- /* Suppresses a compiler warning. */
- (void) caml__frame;
-}
-
/* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
* into values (longs because they are variants in OCaml).
*
diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c
index bf972e9..710c0d6 100644
--- a/libvirt/libvirt_c_prologue.c
+++ b/libvirt/libvirt_c_prologue.c
@@ -25,7 +25,6 @@ typedef value (*Val_ptr_t) (void *);
static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
/*static value option_default (value option, value deflt);*/
static void _raise_virterror (const char *fn) Noreturn;
-static void not_supported (const char *fn) Noreturn;
static value Val_virterror (virErrorPtr err);
/* Use this around synchronous libvirt API calls to release the OCaml
--
2.5.0

1864
SOURCES/0001-Suppress-errors-to-stderr-and-use-thread-local-virEr.patch
View File

File diff suppressed because it is too large Load Diff

35
SOURCES/0001-Use-C99-standard-int64_t-instead-of-OCaml-defined-an.patch
View File

@ -1,35 +0,0 @@
From 21ac993da0a187821e812fe7b5b31a426121a546 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Sat, 30 Aug 2014 19:10:19 +0100
Subject: [PATCH] Use C99 standard int64_t instead of OCaml defined (and soon
to go) int64.
---
libvirt/libvirt_c_oneoffs.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 3bb572f..06b3852 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -140,7 +140,7 @@ ocaml_libvirt_connect_node_get_free_memory (value connv)
NONBLOCKING (r = virNodeGetFreeMemory (conn));
CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
- rv = caml_copy_int64 ((int64) r);
+ rv = caml_copy_int64 ((int64_t) r);
CAMLreturn (rv);
}
@@ -161,7 +161,7 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
rv = caml_alloc (r, 0);
for (i = 0; i < r; ++i) {
- iv = caml_copy_int64 ((int64) freemems[i]);
+ iv = caml_copy_int64 ((int64_t) freemems[i]);
Store_field (rv, i, iv);
}
--
2.0.4

78
SOURCES/0001-Use-g-warn-error.patch
View File

@ -1,78 +0,0 @@
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

76
SOURCES/0001-Use-safe-string-and-fix-the-library.patch
View File

@ -1,76 +0,0 @@
From bab7f84ade84ceaddb08b6948792d49b3d04b897 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Wed, 8 Nov 2017 16:52:58 +0000
Subject: [PATCH] Use -safe-string and fix the library.
Note this changes the type of the cpumap from string to bytes,
since (by the design of the API) it must be mutated.
---
libvirt/Makefile.in | 4 ++--
libvirt/libvirt.ml | 10 +++++-----
libvirt/libvirt.mli | 6 +++---
3 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in
index cf614fc..1eb846b 100644
--- a/libvirt/Makefile.in
+++ b/libvirt/Makefile.in
@@ -31,11 +31,11 @@ OCAMLMKLIB = @OCAMLMKLIB@
ifneq ($(OCAMLFIND),)
OCAMLCPACKAGES := -package unix
-OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3 -safe-string
OCAMLCLIBS := -linkpkg
else
OCAMLCINCS :=
-OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3 -safe-string
OCAMLCLIBS := unix.cma
endif
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index d03a127..7e1e470 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -92,13 +92,13 @@ struct
(* See VIR_USE_CPU, VIR_UNUSE_CPU, VIR_CPU_USABLE macros defined in <libvirt.h>. *)
let use_cpu cpumap cpu =
- cpumap.[cpu/8] <-
- Char.chr (Char.code cpumap.[cpu/8] lor (1 lsl (cpu mod 8)))
+ Bytes.set cpumap (cpu/8)
+ (Char.chr (Char.code (Bytes.get cpumap (cpu/8)) lor (1 lsl (cpu mod 8))))
let unuse_cpu cpumap cpu =
- cpumap.[cpu/8] <-
- Char.chr (Char.code cpumap.[cpu/8] land (lnot (1 lsl (cpu mod 8))))
+ Bytes.set cpumap (cpu/8)
+ (Char.chr (Char.code (Bytes.get cpumap (cpu/8)) land (lnot (1 lsl (cpu mod 8)))))
let cpu_usable cpumaps maplen vcpu cpu =
- Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0
+ Char.code (Bytes.get cpumaps (vcpu*maplen + cpu/8)) land (1 lsl (cpu mod 8)) <> 0
external set_keep_alive : [>`R] t -> int -> int -> unit = "ocaml_libvirt_connect_set_keep_alive"
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index dc0033b..87f50f5 100644
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -376,11 +376,11 @@ sig
CPU map between a single virtual and all physical CPUs of a domain.
*)
- val use_cpu : string -> int -> unit
+ val use_cpu : bytes -> int -> unit
(** [use_cpu cpumap cpu] marks [cpu] as usable in [cpumap]. *)
- val unuse_cpu : string -> int -> unit
+ val unuse_cpu : bytes -> int -> unit
(** [unuse_cpu cpumap cpu] marks [cpu] as not usable in [cpumap]. *)
- val cpu_usable : string -> int -> int -> int -> bool
+ val cpu_usable : bytes -> int -> int -> int -> bool
(** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the
[cpu] is usable by [vcpu]. *)
--
2.13.1

32
SOURCES/0002-Don-t-bother-checking-return-from-virInitialize.patch
View File

@ -1,32 +0,0 @@
From 06b24089986523806d386b9e3cfa4fcf5eeb87e6 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 17 Mar 2015 12:53:29 +0000
Subject: [PATCH 2/2] Don't bother checking return from virInitialize.
The Perl bindings don't do this, and it seems that the call can never
fail, or if it does we don't care.
---
libvirt/libvirt_c_oneoffs.c | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 32e5a4b..5d82194 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -1229,12 +1229,9 @@ CAMLprim value
ocaml_libvirt_init (value unit)
{
CAMLparam1 (unit);
- CAMLlocal1 (rv);
- int r;
virSetErrorFunc (NULL, ignore_errors);
- r = virInitialize ();
- CHECK_ERROR (r == -1, "virInitialize");
+ virInitialize ();
CAMLreturn (Val_unit);
}
--
2.3.1

44
SOURCES/0002-Update-dependencies.patch
View File

@ -1,44 +0,0 @@
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
SOURCES/0003-Add-a-binding-for-virConnectGetAllDomainStats-RHBZ-1.patch
View File

@ -1,393 +0,0 @@
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

42
SOURCES/0004-examples-Print-more-stats-in-the-get_all_domain_stat.patch
View File

@ -1,42 +0,0 @@
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
SOURCES/0005-Change-binding-of-virConnectGetAllDomainStats-to-ret.patch
View File

@ -1,127 +0,0 @@
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

6
gating.yaml Executable file
View File

@ -0,0 +1,6 @@
--- !Policy
product_versions:
- rhel-*
decision_context: osci_compose_gate
rules:
- !PassingTestCaseRule {test_case_name: osci.brew-build.tier0.functional}

236
SPECS/ocaml-libvirt.spec → ocaml-libvirt.spec
View File

@ -1,44 +1,27 @@
# OCaml packages not built on i686 since OCaml 5 / Fedora 39.
ExcludeArch: %{ix86}
Name: ocaml-libvirt
Version: 0.6.1.4
Release: 29%{?dist}
Version: 0.6.1.7
Release: 13%{?dist}
Summary: OCaml binding for libvirt
License: LGPLv2+
License: LGPL-2.1-or-later
URL: http://libvirt.org/ocaml/
Source0: http://libvirt.org/sources/ocaml/%{name}-%{version}.tar.gz
# Upstream patch to fix int types.
Patch1: 0001-Use-C99-standard-int64_t-instead-of-OCaml-defined-an.patch
# Upstream patch to add virDomainCreateXML binding.
Patch2: 0001-Add-a-binding-for-virDomainCreateXML.patch
# Upstream patches to fix error handling.
Patch3: 0001-Suppress-errors-to-stderr-and-use-thread-local-virEr.patch
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
# Upstream patch to use -safe-string.
Patch11: 0001-Use-safe-string-and-fix-the-library.patch
URL: https://ocaml.libvirt.org/
Source0: https://download.libvirt.org/ocaml/%{name}-%{version}.tar.gz
BuildRequires: make
BuildRequires: ocaml >= 3.10.0
BuildRequires: ocaml-ocamldoc
BuildRequires: ocaml-findlib-devel
BuildRequires: ocaml-rpm-macros
BuildRequires: libvirt-devel >= 0.2.1
BuildRequires: perl-interpreter
BuildRequires: gawk
BuildRequires: autoconf
BuildRequires: automake
BuildRequires: libtool
%description
@ -47,7 +30,7 @@ OCaml binding for libvirt.
%package devel
Summary: Development files for %{name}
Requires: %{name} = %{version}-%{release}
Requires: %{name}%{?_isa} = %{version}-%{release}
%description devel
@ -59,13 +42,19 @@ developing applications that use %{name}.
%setup -q
%autopatch -p1
# Fix detection of ocamlopt and ocamldoc
# https://gitlab.com/libvirt/libvirt-ocaml/-/merge_requests/27
sed -i '/AM_CONDITIONAL/s/"x"/"xno"/' configure.ac
# Regenerate the configure script
autoreconf -fi -I m4 .
%build
# Parallel builds do not work.
unset MAKEFLAGS
%configure
make all doc
%ifarch %{ocaml_native_compiler}
make opt
%endif
make
%install
@ -74,37 +63,164 @@ export DESTDIR=$RPM_BUILD_ROOT
export OCAMLFIND_DESTDIR=$RPM_BUILD_ROOT%{_libdir}/ocaml
mkdir -p $OCAMLFIND_DESTDIR $OCAMLFIND_DESTDIR/stublibs
mkdir -p $RPM_BUILD_ROOT%{_bindir}
%ifarch %{ocaml_native_compiler}
make install-opt
%else
make install-byte
%endif
make install
%ocaml_files
%files
%doc COPYING.LIB README ChangeLog
%{_libdir}/ocaml/libvirt
%ifarch %{ocaml_native_compiler}
%exclude %{_libdir}/ocaml/libvirt/*.a
%exclude %{_libdir}/ocaml/libvirt/*.cmxa
%exclude %{_libdir}/ocaml/libvirt/*.cmx
%endif
%exclude %{_libdir}/ocaml/libvirt/*.mli
%{_libdir}/ocaml/stublibs/*.so
%{_libdir}/ocaml/stublibs/*.so.owner
%files -f .ofiles
%doc README
%license COPYING.LIB
%files devel
%doc COPYING.LIB README TODO.libvirt ChangeLog html/*
%ifarch %{ocaml_native_compiler}
%{_libdir}/ocaml/libvirt/*.a
%{_libdir}/ocaml/libvirt/*.cmxa
%{_libdir}/ocaml/libvirt/*.cmx
%endif
%{_libdir}/ocaml/libvirt/*.mli
%files devel -f .ofiles-devel
%doc README TODO.libvirt
%license COPYING.LIB
%changelog
* Wed Oct 30 2024 Troy Dawson <tdawson@redhat.com> - 0.6.1.7-13
- Bump release for October 2024 mass rebuild:
Resolves: RHEL-64018
* Tue Jun 25 2024 Troy Dawson <tdawson@redhat.com> - 0.6.1.7-12
- Bump release for June 2024 mass rebuild
* Wed Jun 19 2024 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-11
- OCaml 5.2.0 ppc64le fix
* Wed May 29 2024 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-10
- OCaml 5.2.0 for Fedora 41
* Thu Jan 25 2024 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.7-9
- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild
* Sun Jan 21 2024 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.7-8
- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild
* Mon Dec 18 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-7
- OCaml 5.1.1 + s390x code gen fix for Fedora 40
* Tue Dec 12 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-6
- OCaml 5.1.1 rebuild for Fedora 40
* Thu Oct 05 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-5
- OCaml 5.1 rebuild for Fedora 40
* Thu Jul 20 2023 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.7-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild
* Tue Jul 11 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-3
- OCaml 5.0 rebuild for Fedora 39
* Mon Jul 10 2023 Jerry James <loganjerry@gmail.com> - 0.6.1.7-2
- OCaml 5.0.0 rebuild
- New project URL
- Convert License tag to SPDX
- Fix build on bytecode-only architectures
- Use %%license macro
- Use new OCaml macros
* Mon Feb 13 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.7-1
- New upstream version 0.6.1.7
- Do not try parallel builds.
- Upstream now uses automake.
- Remove ChangeLog file and HTML docs, dropped upstream.
* Tue Jan 24 2023 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.6-5
- Rebuild OCaml packages for F38
* Thu Jan 19 2023 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.6-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild
* Fri Jul 22 2022 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.6-3
- Rebuilt for https://fedoraproject.org/wiki/Fedora_37_Mass_Rebuild
* Sat Jun 18 2022 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.6-2
- OCaml 4.14.0 rebuild
* Thu Apr 28 2022 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.6-1
- New upstream version 0.6.1.6
- Remove patches which are all upstream.
* Fri Feb 04 2022 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-20
- OCaml 4.13.1 rebuild to remove package notes
* Thu Jan 20 2022 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.5-19
- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild
* Mon Oct 04 2021 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-18
- OCaml 4.13.1 build
* Thu Jul 22 2021 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.5-17
- Rebuilt for https://fedoraproject.org/wiki/Fedora_35_Mass_Rebuild
* Mon Mar 1 14:31:55 GMT 2021 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-16
- OCaml 4.12.0 build
* Tue Jan 26 2021 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.5-15
- Rebuilt for https://fedoraproject.org/wiki/Fedora_34_Mass_Rebuild
* Tue Sep 01 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-14
- OCaml 4.11.1 rebuild
* Fri Aug 21 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-13
- OCaml 4.11.0 rebuild
* Tue Jul 28 2020 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.5-12
- Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild
* Mon May 04 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-11
- OCaml 4.11.0+dev2-2020-04-22 rebuild
* Tue Apr 21 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-10
- OCaml 4.11.0 pre-release attempt 2
* Fri Apr 17 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-9
- OCaml 4.11.0 pre-release
* Thu Apr 02 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-8
- Update all OCaml dependencies for RPM 4.16.
* Wed Feb 26 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-7
- OCaml 4.10.0 final.
* Wed Jan 29 2020 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.5-6
- Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild
* Sun Jan 19 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-5
- OCaml 4.10.0+beta1 rebuild.
* Thu Jan 09 2020 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-4
- OCaml 4.09.0 for riscv64
* Fri Dec 06 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-3
- Include upstream patch to fix build for OCaml 4.09.
* Fri Dec 06 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-2
- OCaml 4.09.0 (final) rebuild.
* Wed Aug 21 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-1
- New upstream version 0.6.1.5.
- Remove all patches as they are upstream.
* Fri Aug 16 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-35
- OCaml 4.08.1 (final) rebuild.
* Wed Jul 31 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-34
- OCaml 4.08.1 (rc2) rebuild.
* Thu Jul 25 2019 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.4-33
- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild
* Thu Jun 27 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-32
- OCaml 4.08.0 (final) rebuild.
* Mon Apr 29 2019 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-31
- OCaml 4.08.0 (beta 3) rebuild.
* Fri Feb 01 2019 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.4-30
- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
* Fri Jul 13 2018 Fedora Release Engineering <releng@fedoraproject.org> - 0.6.1.4-29
- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild

1
sources Normal file
View File

@ -0,0 +1 @@
SHA512 (ocaml-libvirt-0.6.1.7.tar.gz) = ec4ebb69701b15a0c258e78f0e9eb9b1f2a75a86384392e8622ad7f4c85dfc598d51d95698835a2ea401b5647b3ad325ff820cbb7d0e524551ff07c26a54de2b

8
tests/basic-test.sh Executable file
View File

@ -0,0 +1,8 @@
#!/bin/bash -
set -e
set -x
# Compile trivial libvirt program.
echo 'print_endline Libvirt_version.version' > virttest.ml
ocamlfind ocamlopt -package libvirt virttest.ml -linkpkg -o virttest
./virttest

13
tests/tests.yml Executable file
View File

@ -0,0 +1,13 @@
- hosts: localhost
roles:
- role: standard-test-basic
tags:
- classic
required_packages:
- ocaml
- ocaml-findlib
- ocaml-libvirt-devel
tests:
- simple:
dir: .
run: ./basic-test.sh