ocaml: Allow Guestfs.t handle to be garbage collected.

** NB: This is an API break for OCaml programs using Guestfs.event_callback. **

Because of the way I implemented Guestfs.event_callback which had the
Guestfs.t handle as the first parameter, we had to store the (OCaml)
Guestfs.t handle in the C handle's private data area.  To do that, we
had to create a global root pointing to the handle.

This of course meant that the handle could not be garbage collected
(thanks Roman Kagan for spotting this).

This changes the API of Guestfs.event_callback so that a handle is no
longer passed.  The OCaml handle can now be garbage collected again.

For programs that need the Guestfs.t handle in the callback function
(which turns out to be *none* of the OCaml programs we have written),
you can do:

  g#set_event_callback (callback_fn g) [Guestfs.EVENT_FOO];

In this case, since the closure passed to Guestfs.set_event_callback
is still registered as a global root, that will capture a reference to
the handle, so the handle won't be able to be garbage collected until
you delete the callback.

generator/ocaml.ml

@@ -107,8 +107,7 @@ val event_all : event list
 type event_handle
 (** The opaque event handle which can be used to delete event callbacks. *)
 
-type event_callback =
-  t -> event -> event_handle -> string -> int64 array -> unit
+type event_callback = event -> event_handle -> string -> int64 array -> unit
 (** The event callback. *)
 
 val set_event_callback : t -> event_callback -> event list -> event_handle
@@ -117,9 +116,7 @@ val set_event_callback : t -> event_callback -> event list -> event_handle
 
     Note that if the closure captures a reference to the handle,
     this reference will prevent the handle from being
-    automatically closed by the garbage collector.  Since the
-    handle is passed to the event callback, with careful programming
-    it should be possible to avoid capturing the handle in the closure. *)
+    automatically closed by the garbage collector. *)
 
 val delete_event_callback : t -> event_handle -> unit
 (** [delete_event_callback g eh] removes a previously registered
@@ -321,8 +318,7 @@ let event_all = [
 
 type event_handle = int
 
-type event_callback =
-  t -> event -> event_handle -> string -> int64 array -> unit
+type event_callback = event -> event_handle -> string -> int64 array -> unit
 
 external set_event_callback : t -> event_callback -> event list -> event_handle
   = \"ocaml_guestfs_set_event_callback\"

mllib/progress.ml

@@ -38,13 +38,13 @@ let set_up_progress_bar ?(machine_readable = false) (g : Guestfs.guestfs) =
     let bar = progress_bar_init ~machine_readable in
 
     (* Reset the progress bar before every libguestfs function. *)
-    let enter_callback g event evh buf array =
+    let enter_callback event evh buf array =
       if event = G.EVENT_ENTER then
         progress_bar_reset bar
     in
 
     (* A progress event: move the progress bar. *)
-    let progress_callback g event evh buf array =
+    let progress_callback event evh buf array =
       if event = G.EVENT_PROGRESS && Array.length array >= 4 then (
         let position = array.(2)
         and total = array.(3) in

ocaml/guestfs-c.c

@@ -78,8 +78,6 @@ guestfs_finalize (value gv)
     size_t len, i;
     value **roots = get_all_event_callbacks (g, &len);
 
-    value *v = guestfs_get_private (g, "_ocaml_g");
-
     /* 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.
@@ -92,9 +90,6 @@ guestfs_finalize (value gv)
       free (roots[i]);
     }
     free (roots);
-
-    caml_remove_generational_global_root (v);
-    free (v);
   }
 }
 
@@ -156,7 +151,6 @@ ocaml_guestfs_create (value environmentv, value close_on_exitv, value unitv)
   CAMLlocal1 (gv);
   unsigned flags = 0;
   guestfs_h *g;
-  value *v;
 
   if (environmentv != Val_int (0) &&
       !Bool_val (Field (environmentv, 0)))
@@ -174,14 +168,6 @@ ocaml_guestfs_create (value environmentv, value close_on_exitv, value unitv)
 
   gv = Val_guestfs (g);
 
-  /* Store the OCaml handle into the C handle.  This is only so we can
-   * map the C handle to the OCaml handle in event_callback_wrapper.
-   */
-  v = guestfs_int_safe_malloc (g, sizeof *v);
-  *v = gv;
-  caml_register_generational_global_root (v);
-  guestfs_set_private (g, "_ocaml_g", v);
-
   CAMLreturn (gv);
 }
 
@@ -358,14 +344,10 @@ event_callback_wrapper_locked (guestfs_h *g,
                                const uint64_t *array, size_t array_len)
 {
   CAMLparam0 ();
-  CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
+  CAMLlocal4 (evv, ehv, bufv, arrayv);
   CAMLlocal2 (rv, v);
-  value *root;
   size_t i;
 
-  root = guestfs_get_private (g, "_ocaml_g");
-  gv = *root;
-
   /* Only one bit should be set in 'event'.  Which one? */
   evv = Val_int (event_bitmask_to_event (event));
 
@@ -380,9 +362,9 @@ event_callback_wrapper_locked (guestfs_h *g,
     Store_field (arrayv, i, v);
   }
 
-  value args[5] = { gv, evv, ehv, bufv, arrayv };
+  value args[4] = { evv, ehv, bufv, arrayv };
 
-  rv = caml_callbackN_exn (*(value*)data, 5, args);
+  rv = caml_callbackN_exn (*(value*)data, 4, args);
 
   /* Callbacks shouldn't throw exceptions.  There's not much we can do
    * except to print it.

ocaml/t/guestfs_410_close_event.ml

@@ -18,7 +18,7 @@
 
 let close_invoked = ref 0
 
-let close _ _ _ _ _ =
+let close _ _ _ _ =
   incr close_invoked
 
 let () =

ocaml/t/guestfs_420_log_messages.ml

@@ -20,7 +20,7 @@ open Printf
 
 let log_invoked = ref 0
 
-let log g ev eh buf array =
+let log ev eh buf array =
   let eh : int = Obj.magic eh in
 
   printf "event logged: event=%s eh=%d buf=%S array=[%s]\n"

ocaml/t/guestfs_430_progress_messages.ml

@@ -18,7 +18,7 @@
 
 let callback_invoked = ref 0
 
-let callback _ _ _ _ _ = incr callback_invoked
+let callback _ _ _ _ = incr callback_invoked
 
 let () =
   let g = new Guestfs.guestfs () in