diff --git a/0001-ocaml-Use-Gc.finalise-instead-of-a-C-finalizer.patch b/0001-ocaml-Use-Gc.finalise-instead-of-a-C-finalizer.patch new file mode 100644 index 0000000..5e3296e --- /dev/null +++ b/0001-ocaml-Use-Gc.finalise-instead-of-a-C-finalizer.patch @@ -0,0 +1,134 @@ +From 61418535ad63b5a2a91f1caf4703d7134834e4dd Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Wed, 13 Dec 2023 22:50:56 +0000 +Subject: [PATCH 1/2] 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 +--- + 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 07ccd26924..1e6f603ab2 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 8a8761e883..700c33abf4 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); + } +-- +2.43.0 + diff --git a/0002-ocaml-Nullify-custom-block-before-releasing-runtime-.patch b/0002-ocaml-Nullify-custom-block-before-releasing-runtime-.patch new file mode 100644 index 0000000..80b67ab --- /dev/null +++ b/0002-ocaml-Nullify-custom-block-before-releasing-runtime-.patch @@ -0,0 +1,41 @@ +From e93fd7e8acf34192c0d1b70611e3474dde346941 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Thu, 14 Dec 2023 08:33:10 +0000 +Subject: [PATCH 2/2] ocaml: Nullify custom block before releasing runtime lock + +Avoids a potential, though if possible then very rare, double free +path. + +Suggested-by: Guillaume Munch-Maccagnoni +See: https://github.com/ocaml/ocaml/issues/12820 +--- + ocaml/guestfs-c.c | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c +index 700c33abf4..ea9a0598a6 100644 +--- a/ocaml/guestfs-c.c ++++ b/ocaml/guestfs-c.c +@@ -156,6 +156,9 @@ guestfs_int_ocaml_close (value gv) + size_t len; + value **roots = get_all_event_callbacks (g, &len); + ++ /* So we don't double-free. */ ++ 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. +@@ -173,9 +176,6 @@ guestfs_int_ocaml_close (value gv) + } + free (roots); + } +- +- /* So we don't double-free. */ +- Guestfs_val (gv) = NULL; + } + + CAMLreturn (Val_unit); +-- +2.43.0 + diff --git a/libguestfs.spec b/libguestfs.spec index 1a2e710..56905e1 100644 --- a/libguestfs.spec +++ b/libguestfs.spec @@ -50,7 +50,7 @@ Summary: Access and modify virtual machine disk images Name: libguestfs Epoch: 1 Version: 1.51.9 -Release: 2%{?dist} +Release: 3%{?dist} License: LGPL-2.1-or-later # Build only for architectures that have a kernel @@ -84,6 +84,10 @@ Source7: libguestfs.keyring # Maintainer script which helps with handling patches. Source8: copy-patches.sh +# Fixes for https://github.com/ocaml/ocaml/issues/12820 +Patch: 0001-ocaml-Use-Gc.finalise-instead-of-a-C-finalizer.patch +Patch: 0002-ocaml-Nullify-custom-block-before-releasing-runtime-.patch + %if 0%{patches_touch_autotools} BuildRequires: autoconf, automake, libtool, gettext-devel %endif @@ -1094,6 +1098,9 @@ rm ocaml/html/.gitignore %changelog +* Thu Dec 14 2023 Richard W.M. Jones - 1:1.51.9-3 +- Fixes for https://github.com/ocaml/ocaml/issues/12820 + * Tue Dec 12 2023 Richard W.M. Jones - 1:1.51.9-2 - OCaml 5.1.1 rebuild for Fedora 40