10:33 a.m.
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