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

In another patch in this series, we generalize the "--key" selector parsing for C-language utilities. Adapt the OCaml-language "--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(a)redhat.com&gt; --- Notes: v2: - fix typo in commit message (s/langauge/language/) [Rich] - handle internal type error with abort() [Rich] mltools/tools_utils.ml | 14 ++++++-- mltools/tools_utils-c.c | 38 +++++++++++--------- 2 files changed, 34 insertions(+), 18 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 c703998d4838..d22a5e65b0c2 100644 --- a/mltools/tools_utils-c.c +++ b/mltools/tools_utils-c.c @@ -60,26 +60,32 @@ 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: - abort (); - } + 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: + abort (); + } + else + switch (Int_val (v)) { + default: + abort (); + } ks = key_store_import_key (ks, &key); keysv = Field (keysv, 1); } -- 2.19.1.3.g30247aa5d201