[Libguestfs] [PATCH 3/4] common/mltools: allow fd for machine readable output

[Pino Toscano]

Allow to specify a file descriptor for the machine readable output.

Sadly, the OCaml C glue for the channels is not public API, so enable
the internals for this...
---
 common/mltools/tools_utils-c.c | 17 +++++++++++++++++
 common/mltools/tools_utils.ml  | 10 +++++++++-
 lib/guestfs.pod                |  5 +++++
 3 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/common/mltools/tools_utils-c.c b/common/mltools/tools_utils-c.c
index c88c95082..553aa6631 100644
--- a/common/mltools/tools_utils-c.c
+++ b/common/mltools/tools_utils-c.c
@@ -29,6 +29,9 @@
 #include <caml/memory.h>
 #include <caml/mlvalues.h>
 #include <caml/unixsupport.h>
+/* Evil ... */
+#define CAML_INTERNALS
+#include <caml/io.h>
 
 #include <guestfs.h>
 
@@ -37,6 +40,7 @@
 extern value guestfs_int_mllib_inspect_decrypt (value gv, value gpv, value keysv);
 extern value guestfs_int_mllib_set_echo_keys (value unitv);
 extern value guestfs_int_mllib_set_keys_from_stdin (value unitv);
+extern value guestfs_int_mllib_open_out_channel_from_fd (value fdv);
 
 /* Interface with the guestfish inspection and decryption code. */
 int echo_keys = 0;
@@ -103,3 +107,16 @@ guestfs_int_mllib_set_keys_from_stdin (value unitv)
   keys_from_stdin = 1;
   return Val_unit;
 }
+
+value
+guestfs_int_mllib_open_out_channel_from_fd (value fdv)
+{
+  CAMLparam1 (fdv);
+  struct channel *chan;
+
+  chan = caml_open_descriptor_out (Int_val (fdv));
+  if (!chan)
+    caml_raise_out_of_memory ();
+
+  CAMLreturn (caml_alloc_channel (chan));
+}
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index ade4cb37f..3c54cd4a0 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -32,6 +32,7 @@ and key_store_key =
 external c_inspect_decrypt : Guestfs.t -> int64 -> (string * key_store_key) list -> unit = "guestfs_int_mllib_inspect_decrypt"
 external c_set_echo_keys : unit -> unit = "guestfs_int_mllib_set_echo_keys" "noalloc"
 external c_set_keys_from_stdin : unit -> unit = "guestfs_int_mllib_set_keys_from_stdin" "noalloc"
+external c_out_channel_from_fd : int -> out_channel = "guestfs_int_mllib_open_out_channel_from_fd"
 
 type machine_readable_fn = {
   pr : 'a. ('a, unit, string, unit) format4 -> 'a;
@@ -41,6 +42,7 @@ type machine_readable_output_type =
   | NoOutput
   | Channel of out_channel
   | File of string
+  | Fd of int
 let machine_readable_output = ref NoOutput
 let machine_readable_channel = ref None
 let machine_readable () =
@@ -50,7 +52,8 @@ let machine_readable () =
         match !machine_readable_output with
         | NoOutput -> None
         | Channel chan -> Some chan
-        | File f -> Some (open_out f) in
+        | File f -> Some (open_out f)
+        | Fd fd -> Some (c_out_channel_from_fd fd) in
       machine_readable_channel := chan
     );
     !machine_readable_channel
@@ -296,6 +299,11 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) ?(machine_read
           | n ->
             error (f_"invalid output stream for --machine-readable: %s") fmt in
         machine_readable_output := Channel chan
+      | "fd" ->
+        (try
+          machine_readable_output := Fd (int_of_string outname)
+        with Failure _ ->
+          error (f_"invalid output fd for --machine-readable: %s") fmt)
       | n ->
         error (f_"invalid output for --machine-readable: %s") fmt
       )
diff --git a/lib/guestfs.pod b/lib/guestfs.pod
index 53cece2da..f11028466 100644
--- a/lib/guestfs.pod
+++ b/lib/guestfs.pod
@@ -3287,6 +3287,11 @@ The possible values are:
 
 =over 4
 
+=item B<fd:>I<fd>
+
+The output goes to the specified I<fd>, which is a file descriptor
+already opened for writing.
+
 =item B<file:>F<filename>
 
 The output goes to the specified F<filename>.
-- 
2.20.1