Re: [Libguestfs] [nbdkit PATCH] ocaml: Add support for dynamic .thread_model

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(a)redhat.com&gt;

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 _______________________________________________ Libguestfs mailing list Libguestfs(a)redhat.com https://www.redhat.com/mailman/listinfo/libguestfs