Re: [Libguestfs] [nbdkit PATCH] ocaml: Support .preconnect callback

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