Libguestfs - Jun 2023 - [PATCH libguestfs 0/4] Fix ups for OCaml 5

No action required here as I have pushed this already, this is
just for your information.

Rich.

Since OCaml 4 the old and confusing caml_enter_blocking_section and
caml_leave_blocking_section calls have been replaced with
caml_release_runtime_system and caml_acquire_runtime_system (in that
order).  Use the new names.
---
 generator/OCaml.ml | 5 +++--
 ocaml/guestfs-c.c  | 5 +++--
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 02d9ee2e91..07ccd26924 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -429,6 +429,7 @@ and generate_ocaml_c ()  #include <caml/memory.h>
 #include <caml/mlvalues.h>
 #include <caml/signals.h>
+#include <caml/threads.h>
 
 #include <guestfs.h>
 #include \"guestfs-utils.h\"
@@ -689,12 +690,12 @@ copy_table (char * const * argv)
       pr "\n";
 
       if blocking then
-        pr "  caml_enter_blocking_section ();\n";
+        pr "  caml_release_runtime_system ();\n";
       pr "  r = %s " c_function;
       generate_c_call_args ~handle:"g" style;
       pr ";\n";
       if blocking then
-        pr "  caml_leave_blocking_section ();\n";
+        pr "  caml_acquire_runtime_system ();\n";
 
       (* Free strings if we copied them above. *)
       List.iter (
diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index 3888c94564..8c8aa46096 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -34,6 +34,7 @@
 #include <caml/mlvalues.h>
 #include <caml/printexc.h>
 #include <caml/signals.h>
+#include <caml/threads.h>
 #include <caml/unixsupport.h>
 
 #include "guestfs-c.h"
@@ -395,12 +396,12 @@ event_callback_wrapper (guestfs_h *g,
   /* Ensure we are holding the GC lock before any GC operations are
    * possible. (RHBZ#725824)
    */
-  caml_leave_blocking_section ();
+  caml_acquire_runtime_system ();
 
   event_callback_wrapper_locked (g, data, event, event_handle, flags,
                                  buf, buf_len, array, array_len);
 
-  caml_enter_blocking_section ();
+  caml_release_runtime_system ();
 }
 
 value
-- 
2.41.0

When finalizing the handle we call guestfs_close.  This function could
be long-running (eg. it may have to shut down the qemu subprocess), so
release the runtime lock.
---
 ocaml/guestfs-c.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index 8c8aa46096..a1865a726a 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -77,7 +77,9 @@ guestfs_finalize (value gv)
      * 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) {
-- 
2.41.0

This fix was originally suggested by J?rgen H?tzel (link below) which
I have lightly modified so it works with OCaml <= 4 too.

Link: https://listman.redhat.com/archives/libguestfs/2023-May/031640.html
Link:
https://discuss.ocaml.org/t/test-caml-state-and-conditionally-caml-acquire-runtime-system-good-or-bad/12489
---
 ocaml/guestfs-c.c | 25 +++++++++++++++++++++++--
 1 file changed, 23 insertions(+), 2 deletions(-)

diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index a1865a726a..67dc354721 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -19,6 +19,7 @@
 #include <config.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <stdbool.h>
 #include <string.h>
 #include <errno.h>
 
@@ -36,6 +37,7 @@
 #include <caml/signals.h>
 #include <caml/threads.h>
 #include <caml/unixsupport.h>
+#include <caml/version.h>
 
 #include "guestfs-c.h"
 
@@ -397,13 +399,32 @@ event_callback_wrapper (guestfs_h *g,
 {
   /* Ensure we are holding the GC lock before any GC operations are
    * possible. (RHBZ#725824)
+   *
+   * There are many paths where we already hold the OCaml lock before
+   * this function, for example "non-blocking" calls, and the
+   * libguestfs global atexit path (which calls guestfs_close).  To
+   * avoid double acquisition we need to check if we already hold the
+   * lock.  OCaml 5 is strict about this.  In earlier OCaml versions
+   * there is no way to check, but they did not implement the lock as
+   * a mutex and so it didn't cause problems.
+   *
+   * See also:
+   *
https://discuss.ocaml.org/t/test-caml-state-and-conditionally-caml-acquire-runtime-system-good-or-bad/12489
    */
-  caml_acquire_runtime_system ();
+#if OCAML_VERSION_MAJOR >= 5
+  bool acquired = caml_state != NULL;
+#else
+  const bool acquired = false;
+#endif
+
+  if (!acquired)
+    caml_acquire_runtime_system ();
 
   event_callback_wrapper_locked (g, data, event, event_handle, flags,
                                  buf, buf_len, array, array_len);
 
-  caml_release_runtime_system ();
+  if (!acquired)
+    caml_release_runtime_system ();
 }
 
 value
-- 
2.41.0

Link:
https://discuss.ocaml.org/t/ocaml-5-forcing-objects-to-be-collected-and-finalized/12492/2
---
 ocaml/t/guestfs_065_implicit_close.ml | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/ocaml/t/guestfs_065_implicit_close.ml
b/ocaml/t/guestfs_065_implicit_close.ml
index f2dfecbd5c..04e511dd8a 100644
--- a/ocaml/t/guestfs_065_implicit_close.ml
+++ b/ocaml/t/guestfs_065_implicit_close.ml
@@ -16,6 +16,14 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA.
  *)
 
+let () +  (* In OCaml 5, Gc.full_major does not actually collect the handle
+   * for unknown reasons.  Skip the test until we can resolve this.
+   *
https://discuss.ocaml.org/t/ocaml-5-forcing-objects-to-be-collected-and-finalized/12492/2
+   *)
+  if Sys.ocaml_version >= "5" then
+    exit 77
+
 let close_invoked = ref 0
 
 let close _ _ _ _ -- 
2.41.0