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: db48794fa8
(cherry picked from commit 61418535ad)
This commit is contained in:
Richard W.M. Jones
2023-12-13 22:50:56 +00:00
parent 64a928f631
commit 27aca404cf
2 changed files with 37 additions and 39 deletions

View File

@@ -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 (

View File

@@ -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);
}