[Libguestfs] [PATCH nbdkit 3/5] ocaml: Implement get_ready method.

[Richard W.M. Jones]

---
 plugins/ocaml/ocaml.c      | 25 +++++++++++++++++++++++++
 plugins/ocaml/NBDKit.ml    |  8 ++++++++
 plugins/ocaml/NBDKit.mli   |  2 ++
 tests/test_ocaml_plugin.ml |  6 ++++++
 4 files changed, 41 insertions(+)

diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index 619a678b..82003343 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -106,6 +106,8 @@ static value config_fn;
 static value config_complete_fn;
 static value thread_model_fn;
 
+static value get_ready_fn;
+
 static value preconnect_fn;
 static value open_fn;
 static value close_fn;
@@ -238,6 +240,25 @@ thread_model_wrapper (void)
   CAMLreturnT (int, Int_val (rv));
 }
 
+static int
+get_ready_wrapper (void)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (rv);
+
+  caml_leave_blocking_section ();
+
+  rv = caml_callback_exn (get_ready_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, 0);
+}
+
 static int
 preconnect_wrapper (int readonly)
 {
@@ -799,6 +820,8 @@ SET(config)
 SET(config_complete)
 SET(thread_model)
 
+SET(get_ready)
+
 SET(preconnect)
 SET(open)
 SET(close)
@@ -840,6 +863,8 @@ remove_roots (void)
   REMOVE (config_complete);
   REMOVE (thread_model);
 
+  REMOVE (get_ready);
+
   REMOVE (preconnect);
   REMOVE (open);
   REMOVE (close);
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index e3b07ab5..ed636c72 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -69,6 +69,8 @@ type 'a plugin = {
   config_help : string;
   thread_model : (unit -> thread_model) option;
 
+  get_ready : (unit -> unit) option;
+
   preconnect : (bool -> unit) option;
   open_connection : (bool -> 'a) option;
   close : ('a -> unit) option;
@@ -111,6 +113,8 @@ let default_callbacks = {
   config_help = "";
   thread_model = None;
 
+  get_ready = None;
+
   preconnect = None;
   open_connection = None;
   close = None;
@@ -152,6 +156,8 @@ external set_config_complete : (unit -> unit) -> unit = "ocaml_nbdkit_set_config
 external set_config_help : string -> unit = "ocaml_nbdkit_set_config_help" "noalloc"
 external set_thread_model : (unit -> thread_model) -> unit = "ocaml_nbdkit_set_thread_model"
 
+external set_get_ready : (unit -> unit) -> unit = "ocaml_nbdkit_set_get_ready"
+
 external set_preconnect : (bool -> unit) -> unit = "ocaml_nbdkit_set_preconnect"
 external set_open : (bool -> 'a) -> unit = "ocaml_nbdkit_set_open"
 external set_close : ('a -> unit) -> unit = "ocaml_nbdkit_set_close"
@@ -214,6 +220,8 @@ let register_plugin plugin =
     set_config_help plugin.config_help;
   may set_thread_model plugin.thread_model;
 
+  may set_get_ready plugin.get_ready;
+
   may set_preconnect plugin.preconnect;
   may set_open plugin.open_connection;
   may set_close plugin.close;
diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index 8cc4fed2..78019442 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -74,6 +74,8 @@ type 'a plugin = {
   config_help : string;
   thread_model : (unit -> thread_model) option;
 
+  get_ready : (unit -> unit) option;
+
   preconnect : (bool -> unit) option;
   open_connection : (bool -> 'a) option;          (* required *)
   close : ('a -> unit) option;
diff --git a/tests/test_ocaml_plugin.ml b/tests/test_ocaml_plugin.ml
index 3cf8fd90..753e51ab 100644
--- a/tests/test_ocaml_plugin.ml
+++ b/tests/test_ocaml_plugin.ml
@@ -19,6 +19,12 @@ let test_config_complete () =
   let params = List.rev !params in
   assert (params = [ "a", "1"; "b", "2"; "c", "3" ])
 
+let test_get_ready () =
+  (* We could allocate the disk here, but it's easier to allocate
+   * it statically above.
+   *)
+  NBDKit.debug "test ocaml plugin getting ready"
+
 let test_open readonly =
   NBDKit.debug "test ocaml plugin handle opened readonly=%b" readonly;
   ()
-- 
2.25.0