[Libguestfs] [nbdkit PATCH 09/10] plugins: Wire up ocaml plugin support for NBD_INFO_INIT_STATE

[Eric Blake]

The NBD protocol is adding an extension to let servers advertise
initialization state to the client: whether the image contains holes,
and whether it is known to read as all zeroes.  For Ocaml, the changes
are just copy-and-paste, but I wasn't sure how to test them beyond a
successful build.

Signed-off-by: Eric Blake <eblake at redhat.com>
---
 plugins/ocaml/NBDKit.ml  | 14 +++++++++++-
 plugins/ocaml/NBDKit.mli |  5 ++++-
 plugins/ocaml/ocaml.c    | 47 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+), 2 deletions(-)

diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index 85c30a1..2db011f 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -100,6 +100,9 @@ type 'a plugin = {
   can_fast_zero : ('a -> bool) option;

   preconnect : (bool -> unit) option;
+
+  init_sparse : ('a -> bool) option;
+  init_zero : ('a -> bool) option;
 }

 let default_callbacks = {
@@ -149,6 +152,9 @@ let default_callbacks = {
   can_fast_zero = None;

   preconnect = None;
+
+  init_sparse = None;
+  init_zero = None;
 }

 external set_name : string -> unit = "ocaml_nbdkit_set_name" "noalloc"
@@ -198,6 +204,9 @@ external set_can_fast_zero : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_fast_z

 external set_preconnect : (bool -> unit) -> unit = "ocaml_nbdkit_set_preconnect"

+external set_init_sparse : ('a -> bool) -> unit = "ocaml_nbdkit_set_init_sparse"
+external set_init_zero : ('a -> bool) -> unit = "ocaml_nbdkit_set_init_zero"
+
 let may f = function None -> () | Some a -> f a

 let register_plugin plugin =
@@ -265,7 +274,10 @@ let register_plugin plugin =

   may set_can_fast_zero plugin.can_fast_zero;

-  may set_preconnect plugin.preconnect
+  may set_preconnect plugin.preconnect;
+
+  may set_init_sparse plugin.init_sparse;
+  may set_init_zero plugin.init_zero;

 external _set_error : int -> unit = "ocaml_nbdkit_set_error" "noalloc"

diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index 4cdf911..966b1bb 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -105,12 +105,15 @@ type 'a plugin = {
   can_fast_zero : ('a -> bool) option;

   preconnect : (bool -> unit) option;
+
+  init_sparse : ('a -> bool) option;
+  init_zero : ('a -> bool) option;
 }
 (** The plugin fields and callbacks.  ['a] is the handle type. *)

 val default_callbacks : 'a plugin
 (** The plugin with all fields set to [None], so you can write
-    [{ defaults_callbacks with field1 = Some foo1; field2 = Some foo2 }] *)
+    [{ default_callbacks with field1 = Some foo1; field2 = Some foo2 }] *)

 val register_plugin : 'a plugin -> unit
 (** Register the plugin with nbdkit. *)
diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index a7d188f..db88f68 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -138,6 +138,9 @@ static value can_fast_zero_fn;

 static value preconnect_fn;

+static value init_sparse_fn;
+static value init_zero_fn;
+
 /*----------------------------------------------------------------------*/
 /* Wrapper functions that translate calls from C (ie. nbdkit) to OCaml. */

@@ -747,6 +750,44 @@ preconnect_wrapper (int readonly)
   CAMLreturnT (int, 1);
 }

+static int
+init_sparse_wrapper (void *h)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (rv);
+
+  caml_leave_blocking_section ();
+
+  rv = caml_callback_exn (init_sparse_fn, *(value *) h);
+  if (Is_exception_result (rv)) {
+    nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
+    caml_enter_blocking_section ();
+    CAMLreturnT (int, -1);
+  }
+
+  caml_enter_blocking_section ();
+  CAMLreturnT (int, Bool_val (rv));
+}
+
+static int
+init_zero_wrapper (void *h)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (rv);
+
+  caml_leave_blocking_section ();
+
+  rv = caml_callback_exn (init_zero_fn, *(value *) h);
+  if (Is_exception_result (rv)) {
+    nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
+    caml_enter_blocking_section ();
+    CAMLreturnT (int, -1);
+  }
+
+  caml_enter_blocking_section ();
+  CAMLreturnT (int, Bool_val (rv));
+}
+
 /*----------------------------------------------------------------------*/
 /* set_* functions called from OCaml code at load time to initialize
  * fields in the plugin struct.
@@ -838,6 +879,9 @@ SET(can_fast_zero)

 SET(preconnect)

+SET(init_sparse)
+SET(init_zero)
+
 #undef SET

 static void
@@ -886,6 +930,9 @@ remove_roots (void)

   REMOVE (preconnect);

+  REMOVE (init_sparse);
+  REMOVE (init_zero);
+
 #undef REMOVE
 }

-- 
2.24.1