[Libguestfs] [nbdkit PATCH] ocaml: Support .preconnect callback
Richard W.M. Jones
rjones at redhat.com
Mon Feb 10 21:08:51 UTC 2020
On Mon, Feb 10, 2020 at 12:47:47PM -0600, Eric Blake wrote:
> Somewhat of a mishmash between .open (in that it takes a bool readonly
> parameter) and .config_complete (in that the C code returns an int,
> but the Ocaml code either throws an exception or completes with unit).
> I did not spot any existing testsuite coverage to modify for this, and
> am relying on the fact that it compiles cleanly.
>
> Signed-off-by: Eric Blake <eblake at redhat.com>
> ---
> plugins/ocaml/NBDKit.ml | 12 ++++++++++--
> plugins/ocaml/NBDKit.mli | 4 +++-
> plugins/ocaml/ocaml.c | 27 ++++++++++++++++++++++++++-
> 3 files changed, 39 insertions(+), 4 deletions(-)
>
> diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
> index 7002ac0..85c30a1 100644
> --- a/plugins/ocaml/NBDKit.ml
> +++ b/plugins/ocaml/NBDKit.ml
> @@ -1,6 +1,6 @@
> (* hey emacs, this is OCaml code: -*- tuareg -*- *)
> (* nbdkit OCaml interface
> - * Copyright (C) 2014-2019 Red Hat Inc.
> + * Copyright (C) 2014-2020 Red Hat Inc.
> *
> * Redistribution and use in source and binary forms, with or without
> * modification, are permitted provided that the following conditions are
> @@ -98,6 +98,8 @@ type 'a plugin = {
> thread_model : (unit -> thread_model) option;
>
> can_fast_zero : ('a -> bool) option;
> +
> + preconnect : (bool -> unit) option;
> }
>
> let default_callbacks = {
> @@ -145,6 +147,8 @@ let default_callbacks = {
> thread_model = None;
>
> can_fast_zero = None;
> +
> + preconnect = None;
> }
>
> external set_name : string -> unit = "ocaml_nbdkit_set_name" "noalloc"
> @@ -192,6 +196,8 @@ external set_thread_model : (unit -> thread_model) -> unit = "ocaml_nbdkit_set_t
>
> external set_can_fast_zero : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_fast_zero"
>
> +external set_preconnect : (bool -> unit) -> unit = "ocaml_nbdkit_set_preconnect"
> +
> let may f = function None -> () | Some a -> f a
>
> let register_plugin plugin =
> @@ -257,7 +263,9 @@ let register_plugin plugin =
>
> may set_thread_model plugin.thread_model;
>
> - may set_can_fast_zero plugin.can_fast_zero
> + may set_can_fast_zero plugin.can_fast_zero;
> +
> + may set_preconnect plugin.preconnect
>
> external _set_error : int -> unit = "ocaml_nbdkit_set_error" "noalloc"
>
> diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
> index 06648b7..4cdf911 100644
> --- a/plugins/ocaml/NBDKit.mli
> +++ b/plugins/ocaml/NBDKit.mli
> @@ -1,6 +1,6 @@
> (* hey emacs, this is OCaml code: -*- tuareg -*- *)
> (* nbdkit OCaml interface
> - * Copyright (C) 2014-2019 Red Hat Inc.
> + * Copyright (C) 2014-2020 Red Hat Inc.
> *
> * Redistribution and use in source and binary forms, with or without
> * modification, are permitted provided that the following conditions are
> @@ -103,6 +103,8 @@ type 'a plugin = {
> thread_model : (unit -> thread_model) option;
>
> can_fast_zero : ('a -> bool) option;
> +
> + preconnect : (bool -> unit) option;
> }
> (** The plugin fields and callbacks. ['a] is the handle type. *)
>
> diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
> index cb69290..a7d188f 100644
> --- a/plugins/ocaml/ocaml.c
> +++ b/plugins/ocaml/ocaml.c
> @@ -1,5 +1,5 @@
> /* nbdkit
> - * Copyright (C) 2014-2019 Red Hat Inc.
> + * Copyright (C) 2014-2020 Red Hat Inc.
> *
> * Redistribution and use in source and binary forms, with or without
> * modification, are permitted provided that the following conditions are
> @@ -136,6 +136,8 @@ static value thread_model_fn;
>
> static value can_fast_zero_fn;
>
> +static value preconnect_fn;
> +
> /*----------------------------------------------------------------------*/
> /* Wrapper functions that translate calls from C (ie. nbdkit) to OCaml. */
>
> @@ -726,6 +728,25 @@ can_fast_zero_wrapper (void *h)
> CAMLreturnT (int, Bool_val (rv));
> }
>
> +static int
> +preconnect_wrapper (int readonly)
> +{
> + CAMLparam0 ();
> + CAMLlocal1 (rv);
> +
> + caml_leave_blocking_section ();
> +
> + rv = caml_callback_exn (preconnect_fn, Val_bool (readonly));
> + 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, 1);
> +}
> +
> /*----------------------------------------------------------------------*/
> /* set_* functions called from OCaml code at load time to initialize
> * fields in the plugin struct.
> @@ -815,6 +836,8 @@ SET(thread_model)
>
> SET(can_fast_zero)
>
> +SET(preconnect)
> +
> #undef SET
>
> static void
> @@ -861,6 +884,8 @@ remove_roots (void)
>
> REMOVE (can_fast_zero);
>
> + REMOVE (preconnect);
> +
> #undef REMOVE
> }
>
Looks fine, ACK.
Rich.
--
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