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

[Richard W.M. Jones]

On Thu, Jun 30, 2022 at 02:20:26PM +0200, Laszlo Ersek wrote:
> 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 at redhat.com>
> ---
> 
> 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

Reviewed-by: Richard W.M. Jones <rjones at redhat.com>


-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW