Re: [Libguestfs] [libguestfs-common PATCH 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-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(a)redhat.com&gt; --- 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 _______________________________________________ Libguestfs mailing list Libguestfs(a)redhat.com https://listman.redhat.com/mailman/listinfo/libguestfs