You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
libguestfs/SOURCES/0036-ocaml-Use-Gc.finalise-...

133 lines
4.1 KiB

From 27aca404cfbfdf9b3d155fa0794f86936525f40c Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Wed, 13 Dec 2023 22:50:56 +0000
Subject: [PATCH] ocaml: Use Gc.finalise instead of a C finalizer
Since OCaml 5.1.1, changes to custom blocks caused C finalizers that
call caml_enter_blocking_section to stop working (if they ever did
before). They are relatively inflexible compared to registering an
OCaml finalizer (Gc.finalise) to call Guestfs.close, so use that
instead.
Suggested-by: Guillaume Munch-Maccagnoni
See: https://github.com/ocaml/ocaml/issues/12820
See: https://gitlab.com/nbdkit/libnbd/-/commit/db48794fa89547a4799b832331e82b4b8b98f03d
(cherry picked from commit 61418535ad63b5a2a91f1caf4703d7134834e4dd)
---
generator/OCaml.ml | 7 ++++-
ocaml/guestfs-c.c | 69 +++++++++++++++++++++-------------------------
2 files changed, 37 insertions(+), 39 deletions(-)
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 07ccd269..1e6f603a 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -312,10 +312,15 @@ type t
exception Error of string
exception Handle_closed of string
-external create : ?environment:bool -> ?close_on_exit:bool -> unit -> t =
+external _create : ?environment:bool -> ?close_on_exit:bool -> unit -> t =
\"guestfs_int_ocaml_create\"
external close : t -> unit = \"guestfs_int_ocaml_close\"
+let create ?environment ?close_on_exit () =
+ let g = _create ?environment ?close_on_exit () in
+ Gc.finalise close g;
+ g
+
type event =
";
List.iter (
diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index 8a8761e8..700c33ab 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -61,43 +61,10 @@ value guestfs_int_ocaml_delete_event_callback (value gv, value eh);
value guestfs_int_ocaml_event_to_string (value events);
value guestfs_int_ocaml_last_errno (value gv);
-/* Allocate handles and deal with finalization. */
-static void
-guestfs_finalize (value gv)
-{
- guestfs_h *g = Guestfs_val (gv);
-
- if (g) {
- /* There is a nasty, difficult to solve case here where the
- * user deletes events in one of the callbacks that we are
- * about to invoke, resulting in a double-free. XXX
- */
- size_t len;
- value **roots = get_all_event_callbacks (g, &len);
-
- /* Close the handle: this could invoke callbacks from the list
- * above, which is why we don't want to delete them before
- * closing the handle.
- */
- caml_release_runtime_system ();
- guestfs_close (g);
- caml_acquire_runtime_system ();
-
- /* Now unregister the global roots. */
- if (roots && len > 0) {
- size_t i;
- for (i = 0; i < len; ++i) {
- caml_remove_generational_global_root (roots[i]);
- free (roots[i]);
- }
- free (roots);
- }
- }
-}
-
+/* Allocate handles. */
static struct custom_operations guestfs_custom_operations = {
(char *) "guestfs_custom_operations",
- guestfs_finalize,
+ custom_finalize_default,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
@@ -179,11 +146,37 @@ value
guestfs_int_ocaml_close (value gv)
{
CAMLparam1 (gv);
+ guestfs_h *g = Guestfs_val (gv);
- guestfs_finalize (gv);
+ if (g) {
+ /* There is a nasty, difficult to solve case here where the
+ * user deletes events in one of the callbacks that we are
+ * about to invoke, resulting in a double-free. XXX
+ */
+ size_t len;
+ value **roots = get_all_event_callbacks (g, &len);
- /* So we don't double-free in the finalizer. */
- Guestfs_val (gv) = NULL;
+ /* Close the handle: this could invoke callbacks from the list
+ * above, which is why we don't want to delete them before
+ * closing the handle.
+ */
+ caml_release_runtime_system ();
+ guestfs_close (g);
+ caml_acquire_runtime_system ();
+
+ /* Now unregister the global roots. */
+ if (roots && len > 0) {
+ size_t i;
+ for (i = 0; i < len; ++i) {
+ caml_remove_generational_global_root (roots[i]);
+ free (roots[i]);
+ }
+ free (roots);
+ }
+
+ /* So we don't double-free. */
+ Guestfs_val (gv) = NULL;
+ }
CAMLreturn (Val_unit);
}