[PATCH for-4.17 v3 01/15] tools/ocaml/libs/eventchn: do not leak event channels and OCaml 5.0 compat

[Edwin Török <edvin.torok@xxxxxxxxxx>]

Add a finalizer on the event channel value, so that it calls
`xenevtchn_close` when the value would be GCed.

In practice oxenstored seems to be the only user of this,
and it creates a single global event channel only,
but freeing this could still be useful when run with OCAMLRUNPARAM=c

The code was previously casting a C pointer to an OCaml value,
which should be avoided: OCaml 5.0 won't support it.
(all "naked" C pointers must be wrapped inside an OCaml value,
 either an Abstract tag, or Nativeint, see the manual
 https://ocaml.org/manual/intfc.html#ss:c-outside-head)

Signed-off-by: Edwin Török <edvin.torok@xxxxxxxxxx>
Acked-by: Christian Lindig <christian.lindig@xxxxxxxxxx>
---
Reason for inclusion in 4.17:
- Fixes a runtime bug with upcoming OCaml 5.0 (already in beta)

Changes since v2:
- added Acked-by line
- add 4.17 reason
---
 tools/ocaml/libs/eventchn/xeneventchn_stubs.c | 29 +++++++++++++++++--
 1 file changed, 27 insertions(+), 2 deletions(-)

diff --git a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c 
b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
index f889a7a2e4..67af116377 100644
--- a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
+++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
@@ -33,7 +33,30 @@
 #include <caml/fail.h>
 #include <caml/signals.h>
 
-#define _H(__h) ((xenevtchn_handle *)(__h))
+/* We want to close the event channel when it is no longer in use,
+   which can only be done safely with a finalizer.
+   Event channels are typically long lived, so we don't need tighter control 
over resource deallocation.
+   Use a custom block
+*/
+
+/* Access the xenevtchn_t* part of the OCaml custom block */
+#define _H(__h) (*((xenevtchn_handle**)Data_custom_val(__h)))
+
+static void stub_evtchn_finalize(value v)
+{
+       /* docs say to not use any CAMLparam* macros here */
+       xenevtchn_close(_H(v));
+}
+
+static struct custom_operations xenevtchn_ops = {
+       "xenevtchn",
+       stub_evtchn_finalize,
+       custom_compare_default, /* raises Failure, cannot compare */
+       custom_hash_default, /* ignored */
+       custom_serialize_default, /* raises Failure, can't serialize */
+       custom_deserialize_default, /* raises Failure, can't deserialize */
+       custom_compare_ext_default /* raises Failure */
+};
 
 CAMLprim value stub_eventchn_init(void)
 {
@@ -48,7 +71,9 @@ CAMLprim value stub_eventchn_init(void)
        if (xce == NULL)
                caml_failwith("open failed");
 
-       result = (value)xce;
+       /* contains file descriptors, trigger full GC at least every 128 
allocations */
+       result = caml_alloc_custom(&xenevtchn_ops, sizeof(xce), 0, 1);
+       _H(result) = xce;
        CAMLreturn(result);
 }
 
-- 
2.34.1