[Libguestfs] [nbdkit PATCH 2/2] ocaml: Implement .list_exports and friends
Eric Blake
eblake at redhat.com
Tue Sep 1 13:25:18 UTC 2020
Fairly straightforward. I'd love for type export to be a bit more
flexible to make description optional, but could not figure out how to
decode that from the C side of things, so for now this just requires
the caller to supply a description for all exports during
.list_exports.
Signed-off-by: Eric Blake <eblake at redhat.com>
---
plugins/ocaml/NBDKit.mli | 9 ++++
plugins/ocaml/NBDKit.ml | 17 ++++++++
plugins/ocaml/example.ml | 33 ++++++++++-----
plugins/ocaml/ocaml.c | 89 ++++++++++++++++++++++++++++++++++++++++
4 files changed, 138 insertions(+), 10 deletions(-)
diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index 3ebbf18f..0d7e325b 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -51,6 +51,12 @@ type extent = {
}
(** The type of the extent list returned by [.extents]. *)
+type export = {
+ name : string;
+ description : string;
+}
+(** The type of the export list returned by [.list_exports]. *)
+
type thread_model =
| THREAD_MODEL_SERIALIZE_CONNECTIONS
| THREAD_MODEL_SERIALIZE_ALL_REQUESTS
@@ -78,10 +84,13 @@ type 'a plugin = {
after_fork : (unit -> unit) option;
preconnect : (bool -> unit) option;
+ list_exports : (bool -> bool -> export list) option;
+ default_export : (bool -> bool -> string) option;
open_connection : (bool -> 'a) option; (* required *)
close : ('a -> unit) option;
get_size : ('a -> int64) option; (* required *)
+ export_description : ('a -> string) option;
can_cache : ('a -> cache_flag) option;
can_extents : ('a -> bool) option;
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index 9ce3bf3e..1d014934 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -53,6 +53,11 @@ type extent = {
is_zero : bool;
}
+type export = {
+ name : string;
+ description : string;
+}
+
type 'a plugin = {
name : string;
longname : string;
@@ -73,10 +78,13 @@ type 'a plugin = {
after_fork : (unit -> unit) option;
preconnect : (bool -> unit) option;
+ list_exports : (bool -> bool -> export list) option;
+ default_export : (bool -> bool -> string) option;
open_connection : (bool -> 'a) option;
close : ('a -> unit) option;
get_size : ('a -> int64) option;
+ export_description : ('a -> string) option;
can_cache : ('a -> cache_flag) option;
can_extents : ('a -> bool) option;
@@ -118,10 +126,13 @@ let default_callbacks = {
after_fork = None;
preconnect = None;
+ list_exports = None;
+ default_export = None;
open_connection = None;
close = None;
get_size = None;
+ export_description = None;
can_cache = None;
can_extents = None;
@@ -162,10 +173,13 @@ external set_get_ready : (unit -> unit) -> unit = "ocaml_nbdkit_set_get_ready"
external set_after_fork : (unit -> unit) -> unit = "ocaml_nbdkit_set_after_fork"
external set_preconnect : (bool -> unit) -> unit = "ocaml_nbdkit_set_preconnect"
+external set_list_exports : (bool -> bool -> export list) -> unit = "ocaml_nbdkit_set_list_exports"
+external set_default_export : (bool -> bool -> string) -> unit = "ocaml_nbdkit_set_default_export"
external set_open : (bool -> 'a) -> unit = "ocaml_nbdkit_set_open"
external set_close : ('a -> unit) -> unit = "ocaml_nbdkit_set_close"
external set_get_size : ('a -> int64) -> unit = "ocaml_nbdkit_set_get_size"
+external set_export_description : ('a -> string) -> unit = "ocaml_nbdkit_set_export_description"
external set_can_cache : ('a -> cache_flag) -> unit = "ocaml_nbdkit_set_can_cache"
external set_can_extents : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_extents"
@@ -225,10 +239,13 @@ let register_plugin plugin =
may set_after_fork plugin.after_fork;
may set_preconnect plugin.preconnect;
+ may set_list_exports plugin.list_exports;
+ may set_default_export plugin.default_export;
may set_open plugin.open_connection;
may set_close plugin.close;
may set_get_size plugin.get_size;
+ may set_export_description plugin.export_description;
may set_can_cache plugin.can_cache;
may set_can_extents plugin.can_extents;
diff --git a/plugins/ocaml/example.ml b/plugins/ocaml/example.ml
index 448de8c4..5dc7b374 100644
--- a/plugins/ocaml/example.ml
+++ b/plugins/ocaml/example.ml
@@ -41,6 +41,13 @@ let ocamlexample_config key value =
| _ ->
failwith (Printf.sprintf "unknown parameter: %s" key)
+let ocamlexample_list_exports ro tls : NBDKit.export list =
+ [ { name = "name1"; description = "desc1" };
+ { name = "name2"; description = "desc2" } ]
+
+let ocamlexample_default_export ro tls =
+ "name1"
+
(* Any type (even unit) can be used as a per-connection handle.
* This is just an example. The same value that you return from
* your [open_connection] function is passed back as the first
@@ -58,6 +65,9 @@ let ocamlexample_open readonly =
incr id;
{ h_id = !id }
+let ocamlexample_export_description h =
+ "some description"
+
let ocamlexample_get_size h =
Int64.of_int (Bytes.length !disk)
@@ -80,20 +90,23 @@ let plugin = {
(* name, open_connection, get_size and pread are required,
* everything else is optional.
*)
- NBDKit.name = "ocamlexample";
- version = "1.0";
+ NBDKit.name = "ocamlexample";
+ version = "1.0";
- load = Some ocamlexample_load;
- unload = Some ocamlexample_unload;
+ load = Some ocamlexample_load;
+ unload = Some ocamlexample_unload;
- config = Some ocamlexample_config;
+ config = Some ocamlexample_config;
- open_connection = Some ocamlexample_open;
- get_size = Some ocamlexample_get_size;
- pread = Some ocamlexample_pread;
- pwrite = Some ocamlexample_pwrite;
+ list_exports = Some ocamlexample_list_exports;
+ default_export = Some ocamlexample_default_export;
+ open_connection = Some ocamlexample_open;
+ export_description = Some ocamlexample_export_description;
+ get_size = Some ocamlexample_get_size;
+ pread = Some ocamlexample_pread;
+ pwrite = Some ocamlexample_pwrite;
- thread_model = Some ocamlexample_thread_model;
+ thread_model = Some ocamlexample_thread_model;
}
let () = NBDKit.register_plugin plugin
diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index d8b61108..a34f67ca 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -123,10 +123,13 @@ static value get_ready_fn;
static value after_fork_fn;
static value preconnect_fn;
+static value list_exports_fn;
+static value default_export_fn;
static value open_fn;
static value close_fn;
static value get_size_fn;
+static value export_description_fn;
static value can_cache_fn;
static value can_extents_fn;
@@ -311,6 +314,64 @@ preconnect_wrapper (int readonly)
CAMLreturnT (int, 0);
}
+static int
+list_exports_wrapper (int readonly, int is_tls, struct nbdkit_exports *exports)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (rv, v);
+
+ caml_leave_blocking_section ();
+
+ rv = caml_callback2_exn (list_exports_fn, Val_bool (readonly),
+ Val_bool (is_tls));
+ if (Is_exception_result (rv)) {
+ nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
+ caml_enter_blocking_section ();
+ CAMLreturnT (int, -1);
+ }
+
+ /* Convert exports list into calls to nbdkit_add_export. */
+ while (rv != Val_int (0)) {
+ const char *name, *desc;
+
+ v = Field (rv, 0); /* export struct */
+ name = String_val (Field (v, 0));
+ desc = String_val (Field (v, 1));
+ if (nbdkit_add_export (exports, name, desc) == -1) {
+ caml_enter_blocking_section ();
+ CAMLreturnT (int, -1);
+ }
+
+ rv = Field (rv, 1);
+ }
+
+ caml_enter_blocking_section ();
+ CAMLreturnT (int, 0);
+}
+
+static const char *
+default_export_wrapper (int readonly, int is_tls)
+{
+ const char *name;
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+
+ caml_leave_blocking_section ();
+
+ rv = caml_callback2_exn (default_export_fn, Val_bool (readonly),
+ Val_bool (is_tls));
+ if (Is_exception_result (rv)) {
+ nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
+ caml_enter_blocking_section ();
+ CAMLreturnT (const char *, NULL);
+ }
+
+ name = nbdkit_strdup_intern (String_val (rv));
+
+ caml_enter_blocking_section ();
+ CAMLreturnT (const char *, name);
+}
+
static void *
open_wrapper (int readonly)
{
@@ -358,6 +419,28 @@ close_wrapper (void *h)
CAMLreturn0;
}
+static const char *
+export_description_wrapper (void *h)
+{
+ const char *desc;
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+
+ caml_leave_blocking_section ();
+
+ rv = caml_callback_exn (export_description_fn, *(value *) h);
+ if (Is_exception_result (rv)) {
+ nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
+ caml_enter_blocking_section ();
+ CAMLreturnT (const char *, NULL);
+ }
+
+ desc = nbdkit_strdup_intern (String_val (rv));
+
+ caml_enter_blocking_section ();
+ CAMLreturnT (const char *, desc);
+}
+
static int64_t
get_size_wrapper (void *h)
{
@@ -856,10 +939,13 @@ SET(get_ready)
SET(after_fork)
SET(preconnect)
+SET(list_exports)
+SET(default_export)
SET(open)
SET(close)
SET(get_size)
+SET(export_description)
SET(can_write)
SET(can_flush)
@@ -900,10 +986,13 @@ remove_roots (void)
REMOVE (after_fork);
REMOVE (preconnect);
+ REMOVE (list_exports);
+ REMOVE (default_export);
REMOVE (open);
REMOVE (close);
REMOVE (get_size);
+ REMOVE (export_description);
REMOVE (can_cache);
REMOVE (can_extents);
--
2.28.0
More information about the Libguestfs
mailing list