[Libguestfs] [libguestfs-common PATCH 10/12] mltools/tools_utils: generalize "--key" selector parsing for OCaml utils

[Laszlo Ersek]

In another patch in this series, we generalize the "--key" selector
parsing for C-language utilities. Adapt the OCaml-langauge "--key" parser:

- Incorporate the new (more informative) error messages for consistency.

- Prepare for selector types that do not take any type-specific
  parameters. These will be represented with constant constructors of the
  "key_store_key" type, and such values are not blocks, but unboxed
  integers:
  <https://v2.ocaml.org/manual/intfc.html#ss:c-concrete-datatypes>.

(This patch is best shown with "git show -b" for review.)

Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=1809453
Signed-off-by: Laszlo Ersek <lersek at redhat.com>
---
 mltools/tools_utils.ml  | 14 ++++++-
 mltools/tools_utils-c.c | 44 ++++++++++++--------
 2 files changed, 38 insertions(+), 20 deletions(-)

diff --git a/mltools/tools_utils.ml b/mltools/tools_utils.ml
index 6006ab7e4f6c..e534cbead47a 100644
--- a/mltools/tools_utils.ml
+++ b/mltools/tools_utils.ml
@@ -390,18 +390,28 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false)
                  L"colour"; L"colours" ], Getopt.Unit set_colours, s_"Use ANSI colour sequences even if not tty");
   add_argspec ([ L"wrap" ],           Getopt.Unit set_wrap,     s_"Wrap log messages even if not tty");
 
   if key_opts then (
     let parse_key_selector arg =
-      let parts = String.nsplit ~max:3 ":" arg in
+      let parts = String.nsplit ":" arg in
       match parts with
+      | [] ->
+        error (f_"selector '%s': missing ID") arg
+      | [ _ ] ->
+        error (f_"selector '%s': missing TYPE") arg
+      | [ _; "key" ]
+      |  _ :: "key" :: _ :: _ :: _ ->
+        error (f_"selector '%s': missing KEY_STRING, or too many fields") arg
       | [ device; "key"; key ] ->
          List.push_back ks.keys (device, KeyString key)
+      | [ _; "file" ]
+      |  _ :: "file" :: _ :: _ :: _ ->
+        error (f_"selector '%s': missing FILENAME, or too many fields") arg
       | [ device; "file"; file ] ->
          List.push_back ks.keys (device, KeyFileName file)
       | _ ->
-         error (f_"invalid selector string for --key: %s") arg
+         error (f_"selector '%s': invalid TYPE") arg
     in
 
     add_argspec ([ L"echo-keys" ],       Getopt.Unit c_set_echo_keys,       s_"Don’t turn off echo for passphrases");
     add_argspec ([ L"keys-from-stdin" ], Getopt.Unit c_set_keys_from_stdin, s_"Read passphrases from stdin");
     add_argspec ([ L"key" ], Getopt.String (s_"SELECTOR", parse_key_selector), s_"Specify a LUKS key");
diff --git a/mltools/tools_utils-c.c b/mltools/tools_utils-c.c
index 081466776666..e9f273ec857f 100644
--- a/mltools/tools_utils-c.c
+++ b/mltools/tools_utils-c.c
@@ -60,28 +60,36 @@ guestfs_int_mllib_inspect_decrypt (value gv, value gpv, value keysv)
     key.id = strdup (String_val (Field (elemv, 0)));
     if (!key.id)
       caml_raise_out_of_memory ();
 
     v = Field (elemv, 1);
-    switch (Tag_val (v)) {
-    case 0:  /* KeyString of string */
-      key.type = key_string;
-      key.string.s = strdup (String_val (Field (v, 0)));
-      if (!key.string.s)
-        caml_raise_out_of_memory ();
-      break;
-    case 1:  /* KeyFileName of string */
-      key.type = key_file;
-      key.file.name = strdup (String_val (Field (v, 0)));
-      if (!key.file.name)
-        caml_raise_out_of_memory ();
-      break;
-    default:
-      error (EXIT_FAILURE, 0,
-             "internal error: unhandled Tag_val (v) = %d",
-             Tag_val (v));
-    }
+    if (Is_block (v))
+      switch (Tag_val (v)) {
+      case 0:  /* KeyString of string */
+        key.type = key_string;
+        key.string.s = strdup (String_val (Field (v, 0)));
+        if (!key.string.s)
+          caml_raise_out_of_memory ();
+        break;
+      case 1:  /* KeyFileName of string */
+        key.type = key_file;
+        key.file.name = strdup (String_val (Field (v, 0)));
+        if (!key.file.name)
+          caml_raise_out_of_memory ();
+        break;
+      default:
+        error (EXIT_FAILURE, 0,
+               "internal error: unhandled Tag_val (v) = %d",
+               Tag_val (v));
+      }
+    else
+      switch (Int_val (v)) {
+      default:
+        error (EXIT_FAILURE, 0,
+               "internal error: unhandled Int_val (v) = %d",
+               Int_val (v));
+      }
 
     ks = key_store_import_key (ks, &key);
 
     keysv = Field (keysv, 1);
   }
-- 
2.19.1.3.g30247aa5d201