[Libguestfs] [nbdkit PATCH] ocaml: Add support for dynamic .thread_model
Eric Blake
eblake at redhat.com
Thu Aug 15 21:52:00 UTC 2019
We do not promise API stability for non-C languages; this is an API
break as follows: instead of calling 'NBDKit.register_plugin model
plugin' with a static model, you can now add .thread_model :(unit ->
thread_model) to plugin or default to PARALLEL.
Since all existing OCaml plugins will have already thought about
thread models, they can convert their existing model into the new
plugin field (and thus, I don't feel too bad making PARALLEL the
default, even if it is not always the safest).
Signed-off-by: Eric Blake <eblake at redhat.com>
---
I'm still looking at two followups:
1) ./nbdkit doesn't set LD_LIBRARY_PATH=plugins/ocaml/.libs:$LD_LIBRARY_PATH
(making ./nbdkit --dump-plugin tests/test-ocaml-plugin.so fail to load
when the system nbdkit is too old)
2) although --dump-plugin shows thread model, ./nbdkit -v log does not;
I need to add a debug() statement for that in server/locks.c
But I was quite pleased that I got this working in under 3 hours (I'm
getting better at OCaml).
plugins/ocaml/nbdkit-ocaml-plugin.pod | 13 ++++++-----
plugins/ocaml/ocaml.c | 33 +++++++++++++++++++++------
plugins/ocaml/NBDKit.ml | 28 ++++++++++++++---------
plugins/ocaml/NBDKit.mli | 19 ++++++++-------
plugins/ocaml/example.ml | 9 +++++---
tests/test_ocaml_plugin.ml | 5 ++--
6 files changed, 69 insertions(+), 38 deletions(-)
diff --git a/plugins/ocaml/nbdkit-ocaml-plugin.pod b/plugins/ocaml/nbdkit-ocaml-plugin.pod
index a66cf26e..4b349612 100644
--- a/plugins/ocaml/nbdkit-ocaml-plugin.pod
+++ b/plugins/ocaml/nbdkit-ocaml-plugin.pod
@@ -36,12 +36,11 @@ Your OCaml code should call C<NBDKit.register_plugin> like this:
open_connection = Some myplugin_open;
get_size = Some myplugin_get_size;
pread = Some myplugin_pread;
+ thread_model = Some (fun () -> NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS);
(* etc *)
}
- let thread_model = NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS
-
- let () = NBDKit.register_plugin thread_model plugin
+ let () = NBDKit.register_plugin plugin
Your plugin must call C<register_plugin> exactly once when the plugin
is loaded.
@@ -108,9 +107,11 @@ to control this.
=head2 Threads
-The first parameter of C<NBDKit.register_plugin> is the thread model,
-which can be one of the values in the table below. For more
-information on thread models, see L<nbdkit-plugin(3)/THREADS>. Note
+One of the members in the plugin record passed to
+C<NBDKit.register_plugin> is C<thread model>, which must return one of
+the values in the table below. For more information on thread models,
+see L<nbdkit-plugin(3)/THREADS>. If this optional function is not
+provided, the thread model defaults to THREAD_MODEL_PARALLEL. Note
that because of the garbage collector lock in OCaml, callbacks are
never truly concurrent.
diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index f664a7fb..01f4448f 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -72,6 +72,7 @@ static void remove_roots (void);
static struct nbdkit_plugin plugin = {
._struct_size = sizeof (plugin),
._api_version = NBDKIT_API_VERSION,
+ ._thread_model = NBDKIT_THREAD_MODEL_PARALLEL,
/* The following field is used as a canary to detect whether the
* OCaml code started up and called us back successfully. If it's
@@ -131,6 +132,8 @@ static value extents_fn;
static value can_cache_fn;
static value cache_fn;
+static value thread_model_fn;
+
/*----------------------------------------------------------------------*/
/* Wrapper functions that translate calls from C (ie. nbdkit) to OCaml. */
@@ -683,18 +686,30 @@ cache_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
CAMLreturnT (int, 0);
}
+static int
+thread_model_wrapper (void)
+{
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+
+ caml_leave_blocking_section ();
+
+ rv = caml_callback_exn (config_complete_fn, Val_unit);
+ 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, Int_val (rv));
+}
+
/*----------------------------------------------------------------------*/
/* set_* functions called from OCaml code at load time to initialize
* fields in the plugin struct.
*/
-value
-ocaml_nbdkit_set_thread_model (value modelv)
-{
- plugin._thread_model = Int_val (modelv);
- return Val_unit;
-}
-
value
ocaml_nbdkit_set_name (value namev)
{
@@ -775,6 +790,8 @@ SET(extents)
SET(can_cache)
SET(cache)
+SET(thread_model)
+
#undef SET
static void
@@ -817,6 +834,8 @@ remove_roots (void)
REMOVE (can_cache);
REMOVE (cache);
+ REMOVE (thread_model);
+
#undef REMOVE
}
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index 02aa2001..57e57a46 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -1,3 +1,4 @@
+(* hey emacs, this is OCaml code: -*- tuareg -*- *)
(* nbdkit OCaml interface
* Copyright (C) 2014-2019 Red Hat Inc.
*
@@ -39,6 +40,12 @@ type fua_flag = FuaNone | FuaEmulate | FuaNative
type cache_flag = CacheNone | CacheEmulate | CacheNop
+type thread_model =
+| THREAD_MODEL_SERIALIZE_CONNECTIONS
+| THREAD_MODEL_SERIALIZE_ALL_REQUESTS
+| THREAD_MODEL_SERIALIZE_REQUESTS
+| THREAD_MODEL_PARALLEL
+
type extent = {
offset : int64;
length : int64;
@@ -87,6 +94,8 @@ type 'a plugin = {
can_cache : ('a -> cache_flag) option;
cache : ('a -> int32 -> int64 -> flags -> unit) option;
+
+ thread_model : (unit -> thread_model) option;
}
let default_callbacks = {
@@ -130,16 +139,10 @@ let default_callbacks = {
can_cache = None;
cache = None;
+
+ thread_model = None;
}
-type thread_model =
-| THREAD_MODEL_SERIALIZE_CONNECTIONS
-| THREAD_MODEL_SERIALIZE_ALL_REQUESTS
-| THREAD_MODEL_SERIALIZE_REQUESTS
-| THREAD_MODEL_PARALLEL
-
-external set_thread_model : int -> unit = "ocaml_nbdkit_set_thread_model" "noalloc"
-
external set_name : string -> unit = "ocaml_nbdkit_set_name" "noalloc"
external set_longname : string -> unit = "ocaml_nbdkit_set_longname" "noalloc"
external set_version : string -> unit = "ocaml_nbdkit_set_version" "noalloc"
@@ -181,9 +184,11 @@ external set_extents : ('a -> int32 -> int64 -> flags -> extent list) -> unit =
external set_can_cache : ('a -> cache_flag) -> unit = "ocaml_nbdkit_set_can_cache"
external set_cache : ('a -> int32 -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_cache"
+external set_thread_model : (unit -> thread_model) -> unit = "ocaml_nbdkit_set_thread_model" "noalloc"
+
let may f = function None -> () | Some a -> f a
-let register_plugin thread_model plugin =
+let register_plugin plugin =
(* Check the required fields have been set by the caller. *)
if plugin.name = "" then
failwith "'.name' field in NBDKit.plugin structure must be set";
@@ -198,7 +203,6 @@ let register_plugin thread_model plugin =
plugin.name);
(* Set the fields in the C code. *)
- set_thread_model (Obj.magic thread_model);
set_name plugin.name;
if plugin.longname <> "" then
@@ -243,7 +247,9 @@ let register_plugin thread_model plugin =
may set_extents plugin.extents;
may set_can_cache plugin.can_cache;
- may set_cache plugin.cache
+ may set_cache plugin.cache;
+
+ may set_thread_model plugin.thread_model
external _set_error : int -> unit = "ocaml_nbdkit_set_error" "noalloc"
diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index bab8f7f6..778250ef 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -1,3 +1,4 @@
+(* hey emacs, this is OCaml code: -*- tuareg -*- *)
(* nbdkit OCaml interface
* Copyright (C) 2014-2019 Red Hat Inc.
*
@@ -50,6 +51,13 @@ type extent = {
}
(** The type of the extent list returned by [.extents]. *)
+type thread_model =
+| THREAD_MODEL_SERIALIZE_CONNECTIONS
+| THREAD_MODEL_SERIALIZE_ALL_REQUESTS
+| THREAD_MODEL_SERIALIZE_REQUESTS
+| THREAD_MODEL_PARALLEL
+(** The type of the thread model returned by [.thread_model]. *)
+
type 'a plugin = {
name : string; (* required *)
longname : string;
@@ -91,6 +99,8 @@ type 'a plugin = {
can_cache : ('a -> cache_flag) option;
cache : ('a -> int32 -> int64 -> flags -> unit) option;
+
+ thread_model : (unit -> thread_model) option;
}
(** The plugin fields and callbacks. ['a] is the handle type. *)
@@ -98,14 +108,7 @@ 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 }] *)
-type thread_model =
-| THREAD_MODEL_SERIALIZE_CONNECTIONS
-| THREAD_MODEL_SERIALIZE_ALL_REQUESTS
-| THREAD_MODEL_SERIALIZE_REQUESTS
-| THREAD_MODEL_PARALLEL
-(** The thread model. *)
-
-val register_plugin : thread_model -> 'a plugin -> unit
+val register_plugin : 'a plugin -> unit
(** Register the plugin with nbdkit. *)
val set_error : Unix.error -> unit
diff --git a/plugins/ocaml/example.ml b/plugins/ocaml/example.ml
index 8ec6f063..45de035f 100644
--- a/plugins/ocaml/example.ml
+++ b/plugins/ocaml/example.ml
@@ -71,6 +71,9 @@ let ocamlexample_pwrite h buf offset _ =
let offset = Int64.to_int offset in
String.blit buf 0 !disk offset len
+let ocamlexample_thread_model () =
+ NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS
+
let plugin = {
NBDKit.default_callbacks with
(* name, open_connection, get_size and pread are required,
@@ -88,8 +91,8 @@ let plugin = {
get_size = Some ocamlexample_get_size;
pread = Some ocamlexample_pread;
pwrite = Some ocamlexample_pwrite;
+
+ thread_model = Some ocamlexample_thread_model;
}
-let thread_model = NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS
-
-let () = NBDKit.register_plugin thread_model plugin
+let () = NBDKit.register_plugin plugin
diff --git a/tests/test_ocaml_plugin.ml b/tests/test_ocaml_plugin.ml
index eb0d9319..3cf8fd90 100644
--- a/tests/test_ocaml_plugin.ml
+++ b/tests/test_ocaml_plugin.ml
@@ -75,8 +75,7 @@ let plugin = {
pwrite = Some test_pwrite;
extents = Some test_extents;
+ thread_model = Some (fun () -> NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS);
}
-let thread_model = NBDKit.THREAD_MODEL_SERIALIZE_CONNECTIONS
-
-let () = NBDKit.register_plugin thread_model plugin
+let () = NBDKit.register_plugin plugin
--
2.20.1
More information about the Libguestfs
mailing list