Mailing List Archive

[xen stable-4.17] tools/ocaml/evtchn: OCaml 5 support, fix potential resource leak
commit d11528a993f80c6a86f4cb0c30578c026348e3e4
Author: Edwin Török <edvin.torok@citrix.com>
AuthorDate: Tue Jan 18 15:04:48 2022 +0000
Commit: Andrew Cooper <andrew.cooper3@citrix.com>
CommitDate: Tue Dec 20 13:13:40 2022 +0000

tools/ocaml/evtchn: OCaml 5 support, fix potential resource leak

There is no binding for xenevtchn_close(). In principle, this is a resource
leak, but the typical usage is as a singleton that lives for the lifetime of
the program.

Ocaml 5 no longer permits storing a naked C pointer in an Ocaml value.

Therefore, use a Custom block. This allows us to use the finaliser callback
to call xenevtchn_close(), if the Ocaml object goes out of scope.

Signed-off-by: Edwin Török <edvin.torok@citrix.com>
Signed-off-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
(cherry picked from commit 22d5affdf0cecfa6faae46fbaec68b8018835220)
---
tools/ocaml/libs/eventchn/xeneventchn_stubs.c | 21 +++++++++++++++++++--
1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
index f889a7a2e4..37f1cc4e14 100644
--- a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
+++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
@@ -33,7 +33,22 @@
#include <caml/fail.h>
#include <caml/signals.h>

-#define _H(__h) ((xenevtchn_handle *)(__h))
+#define _H(__h) (*((xenevtchn_handle **)Data_custom_val(__h)))
+
+static void stub_evtchn_finalize(value v)
+{
+ xenevtchn_close(_H(v));
+}
+
+static struct custom_operations xenevtchn_ops = {
+ .identifier = "xenevtchn",
+ .finalize = stub_evtchn_finalize,
+ .compare = custom_compare_default, /* Can't compare */
+ .hash = custom_hash_default, /* Can't hash */
+ .serialize = custom_serialize_default, /* Can't serialize */
+ .deserialize = custom_deserialize_default, /* Can't deserialize */
+ .compare_ext = custom_compare_ext_default, /* Can't compare */
+};

CAMLprim value stub_eventchn_init(void)
{
@@ -48,7 +63,9 @@ CAMLprim value stub_eventchn_init(void)
if (xce == NULL)
caml_failwith("open failed");

- result = (value)xce;
+ result = caml_alloc_custom(&xenevtchn_ops, sizeof(xce), 0, 1);
+ _H(result) = xce;
+
CAMLreturn(result);
}

--
generated by git-patchbot for /home/xen/git/xen.git#stable-4.17