--- 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