Compare commits
No commits in common. "c9" and "c8" have entirely different histories.
2
.gitignore
vendored
2
.gitignore
vendored
@ -1 +1 @@
|
||||
SOURCES/ocaml-libvirt-0.6.1.5.tar.gz
|
||||
SOURCES/ocaml-libvirt-0.6.1.4.tar.gz
|
||||
|
||||
@ -1 +1 @@
|
||||
ca9d1c487f7c7deadfa0d2f09e399e76bc7e9af2 SOURCES/ocaml-libvirt-0.6.1.5.tar.gz
|
||||
013e00c4e32c7d40fae0d0b4750730f6513f9e17 SOURCES/ocaml-libvirt-0.6.1.4.tar.gz
|
||||
|
||||
213
SOURCES/0001-Add-a-binding-for-virDomainCreateXML.patch
Normal file
213
SOURCES/0001-Add-a-binding-for-virDomainCreateXML.patch
Normal file
@ -0,0 +1,213 @@
|
||||
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
|
||||
|
||||
@ -1,38 +0,0 @@
|
||||
From 75b13978f85b32c7a121aa289d8ebf41ba14ee5a Mon Sep 17 00:00:00 2001
|
||||
From: Pino Toscano <ptoscano@redhat.com>
|
||||
Date: Thu, 5 Sep 2019 09:57:09 +0200
|
||||
Subject: [PATCH] Make const the return value of caml_named_value()
|
||||
|
||||
With OCaml >= 4.09 caml_named_value() returns a const value *, so keep
|
||||
the constness to build also in this case.
|
||||
|
||||
Signed-off-by: Pino Toscano <ptoscano@redhat.com>
|
||||
---
|
||||
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 6f56f10..e23c0db 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -1207,7 +1207,7 @@ ocaml_libvirt_event_run_default_impl (value unitv)
|
||||
#define DOMAIN_CALLBACK_BEGIN(NAME) \
|
||||
value connv, domv, callback_id, result; \
|
||||
connv = domv = callback_id = result = Val_int(0); \
|
||||
- static value *callback = NULL; \
|
||||
+ static const value *callback = NULL; \
|
||||
caml_leave_blocking_section(); \
|
||||
if (callback == NULL) \
|
||||
callback = caml_named_value(NAME); \
|
||||
@@ -1433,7 +1433,7 @@ timeout_callback(int timer, void *opaque)
|
||||
{
|
||||
value callback_id, result;
|
||||
callback_id = result = Val_int(0);
|
||||
- static value *callback = NULL;
|
||||
+ static const value *callback = NULL;
|
||||
caml_leave_blocking_section();
|
||||
if (callback == NULL)
|
||||
callback = caml_named_value("Libvirt.timeout_callback");
|
||||
--
|
||||
2.23.0
|
||||
|
||||
57
SOURCES/0001-Remove-unused-not_supported-function.patch
Normal file
57
SOURCES/0001-Remove-unused-not_supported-function.patch
Normal file
@ -0,0 +1,57 @@
|
||||
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
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,35 @@
|
||||
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
Normal file
78
SOURCES/0001-Use-g-warn-error.patch
Normal file
@ -0,0 +1,78 @@
|
||||
From 2ba6898b4dc121b00078e36d5416b3caadd5d05e Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Mon, 27 Mar 2017 14:12:50 +0100
|
||||
Subject: [PATCH 1/5] Use -g -warn-error.
|
||||
|
||||
Use -g for ocamlopt. ocamlopt has supported generating DWARF
|
||||
information for quite a long time.
|
||||
|
||||
Also use -warn-error with the same set of warnings as is used
|
||||
by libguestfs.
|
||||
|
||||
Fix a warning in examples/get_cpu_stats.ml found by enabling
|
||||
-warn-error.
|
||||
---
|
||||
examples/Makefile.in | 4 ++--
|
||||
examples/get_cpu_stats.ml | 2 ++
|
||||
libvirt/Makefile.in | 6 +++---
|
||||
3 files changed, 7 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/examples/Makefile.in b/examples/Makefile.in
|
||||
index 041e382..46006a0 100644
|
||||
--- a/examples/Makefile.in
|
||||
+++ b/examples/Makefile.in
|
||||
@@ -18,10 +18,10 @@
|
||||
OCAMLFIND = @OCAMLFIND@
|
||||
|
||||
OCAMLCPACKAGES := -package unix -I ../libvirt
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := -linkpkg
|
||||
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
|
||||
-OCAMLOPTFLAGS :=
|
||||
+OCAMLOPTFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLOPTLIBS := $(OCAMLCLIBS)
|
||||
|
||||
export LIBRARY_PATH=../libvirt
|
||||
diff --git a/examples/get_cpu_stats.ml b/examples/get_cpu_stats.ml
|
||||
index d7a8d0c..814c85e 100644
|
||||
--- a/examples/get_cpu_stats.ml
|
||||
+++ b/examples/get_cpu_stats.ml
|
||||
@@ -19,9 +19,11 @@ let () =
|
||||
|
||||
let conn = C.connect_readonly () in
|
||||
|
||||
+ (*
|
||||
let nr_pcpus =
|
||||
let info = C.get_node_info conn in
|
||||
C.maxcpus_of_node_info info in
|
||||
+ *)
|
||||
|
||||
let stats =
|
||||
let dom = D.lookup_by_name conn domname in
|
||||
diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in
|
||||
index f7c04bb..cf614fc 100644
|
||||
--- a/libvirt/Makefile.in
|
||||
+++ b/libvirt/Makefile.in
|
||||
@@ -31,15 +31,15 @@ OCAMLMKLIB = @OCAMLMKLIB@
|
||||
|
||||
ifneq ($(OCAMLFIND),)
|
||||
OCAMLCPACKAGES := -package unix
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := -linkpkg
|
||||
else
|
||||
OCAMLCINCS :=
|
||||
-OCAMLCFLAGS := -g
|
||||
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
|
||||
OCAMLCLIBS := unix.cma
|
||||
endif
|
||||
|
||||
-OCAMLOPTFLAGS :=
|
||||
+OCAMLOPTFLAGS := $(OCAMLCFLAGS)
|
||||
ifneq ($(OCAMLFIND),)
|
||||
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
|
||||
OCAMLOPTLIBS := $(OCAMLCLIBS)
|
||||
--
|
||||
2.9.3
|
||||
|
||||
76
SOURCES/0001-Use-safe-string-and-fix-the-library.patch
Normal file
76
SOURCES/0001-Use-safe-string-and-fix-the-library.patch
Normal file
@ -0,0 +1,76 @@
|
||||
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
|
||||
|
||||
@ -1,74 +0,0 @@
|
||||
From 29709872404fad20a9822c43a831f30b7b09f34a Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Sun, 19 Jan 2020 12:58:17 +0000
|
||||
Subject: [PATCH 1/3] block_peek, memory_peek: Use bytes for return buffer.
|
||||
|
||||
Strings are immutable in modern OCaml.
|
||||
---
|
||||
libvirt/libvirt.ml | 4 ++--
|
||||
libvirt/libvirt.mli | 4 ++--
|
||||
libvirt/libvirt_c_oneoffs.c | 4 ++--
|
||||
3 files changed, 6 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
|
||||
index 7f9d0e4..bdb9460 100644
|
||||
--- a/libvirt/libvirt.ml
|
||||
+++ b/libvirt/libvirt.ml
|
||||
@@ -731,8 +731,8 @@ struct
|
||||
external migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t = "ocaml_libvirt_domain_migrate_bytecode" "ocaml_libvirt_domain_migrate_native"
|
||||
external block_stats : [>`R] t -> string -> block_stats = "ocaml_libvirt_domain_block_stats"
|
||||
external interface_stats : [>`R] t -> string -> interface_stats = "ocaml_libvirt_domain_interface_stats"
|
||||
- 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 block_peek : [>`W] t -> string -> int64 -> int -> bytes -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native"
|
||||
+ external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> bytes -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native"
|
||||
|
||||
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"
|
||||
|
||||
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
|
||||
index 0d74199..7900392 100644
|
||||
--- a/libvirt/libvirt.mli
|
||||
+++ b/libvirt/libvirt.mli
|
||||
@@ -708,7 +708,7 @@ sig
|
||||
val interface_stats : [>`R] t -> string -> interface_stats
|
||||
(** Returns network interface stats. *)
|
||||
|
||||
- val block_peek : [>`W] t -> string -> int64 -> int -> string -> int -> unit
|
||||
+ val block_peek : [>`W] t -> string -> int64 -> int -> bytes -> int -> unit
|
||||
(** [block_peek dom path offset size buf boff] reads [size] bytes at
|
||||
[offset] in the domain's [path] block device.
|
||||
|
||||
@@ -717,7 +717,7 @@ sig
|
||||
|
||||
See also {!max_peek}. *)
|
||||
val memory_peek : [>`W] t -> memory_flag list -> int64 -> int ->
|
||||
- string -> int -> unit
|
||||
+ bytes -> int -> unit
|
||||
(** [memory_peek dom Virtual offset size] reads [size] bytes
|
||||
at [offset] in the domain's virtual memory.
|
||||
|
||||
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
|
||||
index 40384e8..8468c73 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -1057,7 +1057,7 @@ ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv,
|
||||
const char *path = String_val (pathv);
|
||||
unsigned long long offset = Int64_val (offsetv);
|
||||
size_t size = Int_val (sizev);
|
||||
- char *buffer = String_val (bufferv);
|
||||
+ unsigned char *buffer = Bytes_val (bufferv);
|
||||
int boff = Int_val (boffv);
|
||||
int r;
|
||||
|
||||
@@ -1089,7 +1089,7 @@ ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv
|
||||
int flags = 0;
|
||||
unsigned long long offset = Int64_val (offsetv);
|
||||
size_t size = Int_val (sizev);
|
||||
- char *buffer = String_val (bufferv);
|
||||
+ unsigned char *buffer = Bytes_val (bufferv);
|
||||
int boff = Int_val (boffv);
|
||||
int r;
|
||||
|
||||
--
|
||||
2.24.1
|
||||
|
||||
@ -0,0 +1,32 @@
|
||||
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
|
||||
|
||||
@ -1,113 +0,0 @@
|
||||
From 3705b9bdcd04dc86474c62e1c8dd8759669842bc Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Sun, 19 Jan 2020 12:59:09 +0000
|
||||
Subject: [PATCH 2/3] String_val returns const char * in OCaml 4.10.
|
||||
|
||||
This should be compatible with earlier versions of OCaml
|
||||
too since we are just assigning a char * to a const char *.
|
||||
---
|
||||
libvirt/generator.pl | 14 +++++++-------
|
||||
libvirt/libvirt_c_oneoffs.c | 6 +++---
|
||||
2 files changed, 10 insertions(+), 10 deletions(-)
|
||||
|
||||
diff --git a/libvirt/generator.pl b/libvirt/generator.pl
|
||||
index ac3dd65..aff371b 100755
|
||||
--- a/libvirt/generator.pl
|
||||
+++ b/libvirt/generator.pl
|
||||
@@ -593,7 +593,7 @@ sub gen_c_code
|
||||
} elsif ($sig =~ /^(\w+), string : unit$/) {
|
||||
"\
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
int r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str));
|
||||
@@ -605,7 +605,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal1 (rv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
int r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str, 0));
|
||||
@@ -618,7 +618,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal1 (rv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
$c_ret_type r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str));
|
||||
@@ -633,7 +633,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal1 (rv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
$c_ret_type r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str, 0));
|
||||
@@ -648,7 +648,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal1 (rv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
unsigned int u = Int_val (uv);
|
||||
$c_ret_type r;
|
||||
|
||||
@@ -735,7 +735,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal2 (rv, connv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
$c_ret_type r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str));
|
||||
@@ -751,7 +751,7 @@ sub gen_c_code
|
||||
"\
|
||||
CAMLlocal2 (rv, connv);
|
||||
" . gen_unpack_args ($1) . "
|
||||
- char *str = String_val (strv);
|
||||
+ const char *str = String_val (strv);
|
||||
$c_ret_type r;
|
||||
|
||||
NONBLOCKING (r = $c_name ($1, str, 0));
|
||||
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
|
||||
index 8468c73..fc2ac13 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -601,7 +601,7 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
|
||||
int nparams = Wosize_val (paramsv);
|
||||
virSchedParameterPtr params;
|
||||
int r, i;
|
||||
- char *name;
|
||||
+ const char *name;
|
||||
|
||||
params = malloc (sizeof (*params) * nparams);
|
||||
if (params == NULL)
|
||||
@@ -1005,7 +1005,7 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv)
|
||||
CAMLparam2 (domv, pathv);
|
||||
CAMLlocal2 (rv,v);
|
||||
virDomainPtr dom = Domain_val (domv);
|
||||
- char *path = String_val (pathv);
|
||||
+ const char *path = String_val (pathv);
|
||||
struct _virDomainBlockStats stats;
|
||||
int r;
|
||||
|
||||
@@ -1028,7 +1028,7 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv)
|
||||
CAMLparam2 (domv, pathv);
|
||||
CAMLlocal2 (rv,v);
|
||||
virDomainPtr dom = Domain_val (domv);
|
||||
- char *path = String_val (pathv);
|
||||
+ const char *path = String_val (pathv);
|
||||
struct _virDomainInterfaceStats stats;
|
||||
int r;
|
||||
|
||||
--
|
||||
2.24.1
|
||||
|
||||
44
SOURCES/0002-Update-dependencies.patch
Normal file
44
SOURCES/0002-Update-dependencies.patch
Normal file
@ -0,0 +1,44 @@
|
||||
From ca9a3227f9937f9cdeb84126f1c74502c9a25047 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Mon, 27 Mar 2017 14:13:47 +0100
|
||||
Subject: [PATCH 2/5] Update dependencies.
|
||||
|
||||
---
|
||||
examples/.depend | 8 ++++----
|
||||
libvirt/.depend | 6 +++---
|
||||
2 files changed, 7 insertions(+), 7 deletions(-)
|
||||
|
||||
diff --git a/examples/.depend b/examples/.depend
|
||||
index b305b76..b5379d8 100644
|
||||
--- a/examples/.depend
|
||||
+++ b/examples/.depend
|
||||
@@ -1,8 +1,8 @@
|
||||
-node_info.cmo : ../libvirt/libvirt.cmi
|
||||
-node_info.cmx : ../libvirt/libvirt.cmx
|
||||
-get_cpu_stats.cmo : ../libvirt/libvirt.cmi
|
||||
-get_cpu_stats.cmx : ../libvirt/libvirt.cmx
|
||||
domain_events.cmo : ../libvirt/libvirt.cmi
|
||||
domain_events.cmx : ../libvirt/libvirt.cmx
|
||||
+get_cpu_stats.cmo : ../libvirt/libvirt.cmi
|
||||
+get_cpu_stats.cmx : ../libvirt/libvirt.cmx
|
||||
list_domains.cmo : ../libvirt/libvirt.cmi
|
||||
list_domains.cmx : ../libvirt/libvirt.cmx
|
||||
+node_info.cmo : ../libvirt/libvirt.cmi
|
||||
+node_info.cmx : ../libvirt/libvirt.cmx
|
||||
diff --git a/libvirt/.depend b/libvirt/.depend
|
||||
index 7d32e13..ee1180c 100644
|
||||
--- a/libvirt/.depend
|
||||
+++ b/libvirt/.depend
|
||||
@@ -1,6 +1,6 @@
|
||||
-libvirt_version.cmi :
|
||||
+libvirt.cmo : libvirt.cmi
|
||||
+libvirt.cmx : libvirt.cmi
|
||||
libvirt.cmi :
|
||||
libvirt_version.cmo : libvirt_version.cmi
|
||||
libvirt_version.cmx : libvirt_version.cmi
|
||||
-libvirt.cmo : libvirt.cmi
|
||||
-libvirt.cmx : libvirt.cmi
|
||||
+libvirt_version.cmi :
|
||||
--
|
||||
2.9.3
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,68 +0,0 @@
|
||||
From 3d3d6af425d369200a7a62a127adf640d94a38a3 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Sun, 19 Jan 2020 13:02:16 +0000
|
||||
Subject: [PATCH 3/3] Don't try to memcpy into a String_val.
|
||||
|
||||
In OCaml 4.10 String_val returns const char *, so we cannot use it as
|
||||
the destination for memcpy. Use Bytes_val instead.
|
||||
---
|
||||
libvirt/generator.pl | 2 +-
|
||||
libvirt/libvirt_c_oneoffs.c | 8 ++++----
|
||||
2 files changed, 5 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/libvirt/generator.pl b/libvirt/generator.pl
|
||||
index aff371b..463a19b 100755
|
||||
--- a/libvirt/generator.pl
|
||||
+++ b/libvirt/generator.pl
|
||||
@@ -440,7 +440,7 @@ sub gen_c_code
|
||||
|
||||
/* UUIDs are byte arrays with a fixed length. */
|
||||
rv = caml_alloc_string (VIR_UUID_BUFLEN);
|
||||
- memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
|
||||
+ memcpy (Bytes_val (rv), uuid, VIR_UUID_BUFLEN);
|
||||
CAMLreturn (rv);
|
||||
"
|
||||
} elsif ($sig =~ /^(\w+) : uuid string$/) {
|
||||
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
|
||||
index fc2ac13..e8472b7 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -394,7 +394,7 @@ ocaml_libvirt_connect_call_auth_default_callback (value listv)
|
||||
elemv = caml_alloc (2, 0);
|
||||
if (cred->result != NULL && cred->resultlen > 0) {
|
||||
v = caml_alloc_string (cred->resultlen);
|
||||
- memcpy (String_val (v), cred->result, cred->resultlen);
|
||||
+ memcpy (Bytes_val (v), cred->result, cred->resultlen);
|
||||
optv = caml_alloc (1, 0);
|
||||
Store_field (optv, 0, v);
|
||||
} else
|
||||
@@ -715,7 +715,7 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
|
||||
|
||||
/* Copy the bitmap. */
|
||||
strv = caml_alloc_string (maxinfo * maplen);
|
||||
- memcpy (String_val (strv), cpumaps, maxinfo * maplen);
|
||||
+ memcpy (Bytes_val (strv), cpumaps, maxinfo * maplen);
|
||||
|
||||
/* Allocate the tuple and return it. */
|
||||
rv = caml_alloc_tuple (3);
|
||||
@@ -900,7 +900,7 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
|
||||
*/
|
||||
v = caml_alloc_string (VIR_UUID_BUFLEN);
|
||||
virDomainGetUUID (rstats[i]->dom, uuid);
|
||||
- memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
|
||||
+ memcpy (Bytes_val (v), uuid, VIR_UUID_BUFLEN);
|
||||
Store_field (dsv, 0, v);
|
||||
|
||||
tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
|
||||
@@ -1646,7 +1646,7 @@ ocaml_libvirt_secret_get_value (value secv)
|
||||
CHECK_ERROR (secval == NULL, "virSecretGetValue");
|
||||
|
||||
rv = caml_alloc_string (size);
|
||||
- memcpy (String_val (rv), secval, size);
|
||||
+ memcpy (Bytes_val (rv), secval, size);
|
||||
free (secval);
|
||||
|
||||
CAMLreturn (rv);
|
||||
--
|
||||
2.24.1
|
||||
|
||||
@ -0,0 +1,42 @@
|
||||
From 2bb6200934090f34f81d1badb9a55f5a86a7fb32 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Tue, 28 Mar 2017 13:11:09 +0100
|
||||
Subject: [PATCH 4/5] examples: Print more stats in the get_all_domain_stats.ml
|
||||
example.
|
||||
|
||||
Updates commit 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd.
|
||||
---
|
||||
examples/get_all_domain_stats.ml | 13 ++++++++++---
|
||||
1 file changed, 10 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/examples/get_all_domain_stats.ml b/examples/get_all_domain_stats.ml
|
||||
index 4375639..cc86da6 100644
|
||||
--- a/examples/get_all_domain_stats.ml
|
||||
+++ b/examples/get_all_domain_stats.ml
|
||||
@@ -40,13 +40,20 @@ let () =
|
||||
|
||||
let conn = C.connect_readonly () in
|
||||
|
||||
- let what_stats = [D.StatsCpuTotal; D.StatsInterface; D.StatsBlock] in
|
||||
- let flags = [D.GetAllDomainsStatsActive; D.GetAllDomainsStatsInactive] in
|
||||
+ let what = [
|
||||
+ D.StatsState;
|
||||
+ D.StatsCpuTotal;
|
||||
+ D.StatsBalloon;
|
||||
+ D.StatsVcpu;
|
||||
+ D.StatsInterface;
|
||||
+ D.StatsBlock;
|
||||
+ ] in
|
||||
+ let who = [] in (* empty list means returns all domains *)
|
||||
|
||||
let quit = ref false in
|
||||
|
||||
while not !quit do
|
||||
- let stats = D.get_all_domain_stats conn what_stats flags in
|
||||
+ let stats = D.get_all_domain_stats conn what who in
|
||||
|
||||
if stats <> [||] then print_stats stats
|
||||
else (
|
||||
--
|
||||
2.9.3
|
||||
|
||||
@ -0,0 +1,127 @@
|
||||
From 3169af3337938e18bf9ecc6ce936d644e14ff3de Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||
Date: Tue, 28 Mar 2017 13:52:51 +0100
|
||||
Subject: [PATCH 5/5] Change binding of virConnectGetAllDomainStats to return
|
||||
dom UUID.
|
||||
|
||||
The virDomainPtr object returned by this binding isn't a reliable
|
||||
virDomainPtr object. The only thing we can safely do with it is to
|
||||
get its UUID. Modify the API correspondingly.
|
||||
|
||||
Updates commit 380f1e05b244ae4750ca5101b5b5a182dcd0d1fd.
|
||||
---
|
||||
examples/get_all_domain_stats.ml | 7 ++++---
|
||||
libvirt/libvirt.ml | 6 +++---
|
||||
libvirt/libvirt.mli | 6 +++---
|
||||
libvirt/libvirt_c_oneoffs.c | 13 +++++++++++--
|
||||
4 files changed, 21 insertions(+), 11 deletions(-)
|
||||
|
||||
diff --git a/examples/get_all_domain_stats.ml b/examples/get_all_domain_stats.ml
|
||||
index cc86da6..be91f77 100644
|
||||
--- a/examples/get_all_domain_stats.ml
|
||||
+++ b/examples/get_all_domain_stats.ml
|
||||
@@ -8,10 +8,11 @@ open Printf
|
||||
module C = Libvirt.Connect
|
||||
module D = Libvirt.Domain
|
||||
|
||||
-let print_stats stats =
|
||||
+let print_stats conn stats =
|
||||
try
|
||||
Array.iter (
|
||||
- fun { D.dom = dom; D.params = params } ->
|
||||
+ fun { D.dom_uuid = uuid; D.params = params } ->
|
||||
+ let dom = D.lookup_by_uuid conn uuid in
|
||||
printf "domain %s:\n" (D.get_name dom);
|
||||
Array.iteri (
|
||||
fun i (field, value) ->
|
||||
@@ -55,7 +56,7 @@ let () =
|
||||
while not !quit do
|
||||
let stats = D.get_all_domain_stats conn what who in
|
||||
|
||||
- if stats <> [||] then print_stats stats
|
||||
+ if stats <> [||] then print_stats conn stats
|
||||
else (
|
||||
printf "no guests found\n";
|
||||
quit := true
|
||||
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
|
||||
index ce1878a..d03a127 100644
|
||||
--- a/libvirt/libvirt.ml
|
||||
+++ b/libvirt/libvirt.ml
|
||||
@@ -408,8 +408,8 @@ struct
|
||||
| StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu
|
||||
| StatsInterface | StatsBlock | StatsPerf
|
||||
|
||||
- type 'a domain_stats_record = {
|
||||
- dom : 'a t;
|
||||
+ type domain_stats_record = {
|
||||
+ dom_uuid : uuid;
|
||||
params : typed_param array;
|
||||
}
|
||||
|
||||
@@ -467,7 +467,7 @@ struct
|
||||
external block_peek : [>`W] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native"
|
||||
external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native"
|
||||
|
||||
- external get_all_domain_stats : 'a Connect.t -> stats_type list -> get_all_domain_stats_flag list -> 'a domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"
|
||||
+ external get_all_domain_stats : [>`R] Connect.t -> stats_type list -> get_all_domain_stats_flag list -> domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"
|
||||
|
||||
external const : [>`R] t -> ro t = "%identity"
|
||||
|
||||
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
|
||||
index d1b5992..dc0033b 100644
|
||||
--- a/libvirt/libvirt.mli
|
||||
+++ b/libvirt/libvirt.mli
|
||||
@@ -494,8 +494,8 @@ sig
|
||||
| StatsState | StatsCpuTotal | StatsBalloon | StatsVcpu
|
||||
| StatsInterface | StatsBlock | StatsPerf
|
||||
|
||||
- type 'a domain_stats_record = {
|
||||
- dom : 'a t;
|
||||
+ type domain_stats_record = {
|
||||
+ dom_uuid : uuid;
|
||||
params : typed_param array;
|
||||
}
|
||||
|
||||
@@ -636,7 +636,7 @@ sig
|
||||
|
||||
See also {!max_peek}. *)
|
||||
|
||||
- external get_all_domain_stats : 'a Connect.t -> stats_type list -> get_all_domain_stats_flag list -> 'a domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"
|
||||
+ external get_all_domain_stats : [>`R] Connect.t -> stats_type list -> get_all_domain_stats_flag list -> domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats"
|
||||
(** [get_all_domain_stats conn stats flags] allows you to read
|
||||
all stats across multiple/all domains in a single call.
|
||||
|
||||
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
|
||||
index 17412f5..958ba69 100644
|
||||
--- a/libvirt/libvirt_c_oneoffs.c
|
||||
+++ b/libvirt/libvirt_c_oneoffs.c
|
||||
@@ -570,6 +570,7 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
|
||||
virDomainStatsRecordPtr *rstats;
|
||||
unsigned int stats = 0, flags = 0;
|
||||
int i, j, r;
|
||||
+ unsigned char uuid[VIR_UUID_BUFLEN];
|
||||
|
||||
/* Get stats and flags. */
|
||||
for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
|
||||
@@ -619,8 +620,16 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
|
||||
rv = caml_alloc (r, 0); /* domain_stats_record array. */
|
||||
for (i = 0; i < r; ++i) {
|
||||
dsv = caml_alloc (2, 0); /* domain_stats_record */
|
||||
- virDomainRef (rstats[i]->dom);
|
||||
- Store_field (dsv, 0, Val_domain (rstats[i]->dom, connv));
|
||||
+
|
||||
+ /* Libvirt returns something superficially resembling a
|
||||
+ * virDomainPtr, but it's not a real virDomainPtr object
|
||||
+ * (eg. dom->id == -1, and its refcount is wrong). The only thing
|
||||
+ * we can safely get from it is the UUID.
|
||||
+ */
|
||||
+ v = caml_alloc_string (VIR_UUID_BUFLEN);
|
||||
+ virDomainGetUUID (rstats[i]->dom, uuid);
|
||||
+ memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
|
||||
+ Store_field (dsv, 0, v);
|
||||
|
||||
tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
|
||||
for (j = 0; j < rstats[i]->nparams; ++j) {
|
||||
--
|
||||
2.9.3
|
||||
|
||||
@ -1,22 +1,37 @@
|
||||
Name: ocaml-libvirt
|
||||
Version: 0.6.1.5
|
||||
Release: 19%{?dist}
|
||||
Version: 0.6.1.4
|
||||
Release: 29%{?dist}
|
||||
Summary: OCaml binding for libvirt
|
||||
License: LGPLv2+
|
||||
|
||||
URL: http://libvirt.org/ocaml/
|
||||
Source0: http://libvirt.org/sources/ocaml/%{name}-%{version}.tar.gz
|
||||
|
||||
# Fixes build with OCaml >= 4.09.
|
||||
# Upstream commit 75b13978f85b32c7a121aa289d8ebf41ba14ee5a.
|
||||
Patch1: 0001-Make-const-the-return-value-of-caml_named_value.patch
|
||||
# Upstream patch to fix int types.
|
||||
Patch1: 0001-Use-C99-standard-int64_t-instead-of-OCaml-defined-an.patch
|
||||
|
||||
# Fixes for OCaml 4.10, sent upstream 2020-01-19.
|
||||
Patch2: 0001-block_peek-memory_peek-Use-bytes-for-return-buffer.patch
|
||||
Patch3: 0002-String_val-returns-const-char-in-OCaml-4.10.patch
|
||||
Patch4: 0003-Don-t-try-to-memcpy-into-a-String_val.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
|
||||
|
||||
BuildRequires: make
|
||||
BuildRequires: ocaml >= 3.10.0
|
||||
BuildRequires: ocaml-ocamldoc
|
||||
BuildRequires: ocaml-findlib-devel
|
||||
@ -90,85 +105,6 @@ make install-byte
|
||||
|
||||
|
||||
%changelog
|
||||
* Fri Mar 11 2022 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-19
|
||||
- Rebuild for EPEL
|
||||
resolves: rhbz#2060850
|
||||
|
||||
* Mon Aug 09 2021 Mohan Boddu <mboddu@redhat.com> - 0.6.1.5-18
|
||||
- Rebuilt for IMA sigs, glibc 2.34, aarch64 flags
|
||||
Related: rhbz#1991688
|
||||
|
||||
* Wed Jun 23 2021 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.5-17
|
||||
- Bump and rebuild
|
||||
resolves: rhbz#1975311
|
||||
|
||||
* Fri Apr 16 2021 Mohan Boddu <mboddu@redhat.com> - 0.6.1.5-16
|
||||
- Rebuilt for RHEL 9 BETA on Apr 15th 2021. Related: rhbz#1947937
|
||||
|
||||
* 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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user