[Libguestfs] [nbdkit PATCH] ocaml: Add support for dynamic .thread_model
Richard W.M. Jones
rjones at redhat.com
Thu Aug 15 21:59:31 UTC 2019
On Thu, Aug 15, 2019 at 04:52:00PM -0500, Eric Blake wrote:
> 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>
Patch looks OK. It would crash pretty early if there was something
wrong in the bindings, so ACK.
> 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)
Yes this is surely a bug. After making that change the line can also
be removed from tests/Makefile.am.
> 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
Yes I guess it's a good idea to add it to the debug output. Helps
with checking that we really got the intended thread model in all
circumstances.
Thanks,
Rich.
> 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
>
> _______________________________________________
> Libguestfs mailing list
> Libguestfs at redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines. Supports shell scripting,
bindings from many languages. http://libguestfs.org
More information about the Libguestfs
mailing list