133 lines
4.1 KiB
Diff
133 lines
4.1 KiB
Diff
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);
|
|
}
|