[Libguestfs] [PATCH nbdkit 4/7] ocaml: Implement .can_multi_conn callback for OCaml plugins.

[Richard W.M. Jones]

---
 plugins/ocaml/ocaml.c    | 25 +++++++++++++++++++++++++
 plugins/ocaml/NBDKit.ml  | 10 +++++++++-
 plugins/ocaml/NBDKit.mli |  2 ++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index 7dd5e4e..a89ad08 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -111,6 +111,8 @@ static value flush_fn;
 static value trim_fn;
 static value zero_fn;
 
+static value can_multi_conn_fn;
+
 /* Wrapper functions that translate calls from C (ie. nbdkit) to OCaml. */
 
 static void
@@ -167,6 +169,8 @@ unload_wrapper (void)
   REMOVE (flush);
   REMOVE (trim);
   REMOVE (zero);
+
+  REMOVE (can_multi_conn);
 }
 
 static int
@@ -550,6 +554,25 @@ zero_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
   CAMLreturnT (int, 0);
 }
 
+static int
+can_multi_conn_wrapper (void *h)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (rv);
+
+  caml_leave_blocking_section ();
+
+  rv = caml_callback_exn (can_multi_conn_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));
+}
+
 value
 ocaml_nbdkit_set_thread_model (value modelv)
 {
@@ -629,6 +652,8 @@ SET(flush)
 SET(trim)
 SET(zero)
 
+SET(can_multi_conn)
+
 /* NB: noalloc function. */
 value
 ocaml_nbdkit_set_error (value nv)
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index 1937bc2..fdeecd3 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -71,6 +71,8 @@ type 'a plugin = {
   flush : ('a -> flags -> unit) option;
   trim : ('a -> int32 -> int64 -> flags -> unit) option;
   zero : ('a -> int32 -> int64 -> flags -> unit) option;
+
+  can_multi_conn : ('a -> bool) option;
 }
 
 let default_callbacks = {
@@ -106,6 +108,8 @@ let default_callbacks = {
   flush = None;
   trim = None;
   zero = None;
+
+  can_multi_conn = None;
 }
 
 type thread_model =
@@ -149,6 +153,8 @@ external set_flush : ('a -> flags -> unit) -> unit = "ocaml_nbdkit_set_flush"
 external set_trim : ('a -> int32 -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_trim"
 external set_zero : ('a -> int32 -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_zero"
 
+external set_can_multi_conn : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_multi_conn"
+
 let may f = function None -> () | Some a -> f a
 
 let register_plugin thread_model plugin =
@@ -203,7 +209,9 @@ let register_plugin thread_model plugin =
   may set_pwrite plugin.pwrite;
   may set_flush plugin.flush;
   may set_trim plugin.trim;
-  may set_zero plugin.zero
+  may set_zero plugin.zero;
+
+  may set_can_multi_conn plugin.can_multi_conn
 
 external _set_error : int -> unit = "ocaml_nbdkit_set_error" "noalloc"
 
diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index c0f9248..ec888ce 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -73,6 +73,8 @@ type 'a plugin = {
   flush : ('a -> flags -> unit) option;
   trim : ('a -> int32 -> int64 -> flags -> unit) option;
   zero : ('a -> int32 -> int64 -> flags -> unit) option;
+
+  can_multi_conn : ('a -> bool) option;
 }
 (** The plugin fields and callbacks.  ['a] is the handle type. *)
 
-- 
2.19.2