[Libguestfs] [libguestfs-common PATCH 04/12] mltools/tools_utils: allow multiple "--key" options for OCaml tools too

Commit c10c8baedb88 ("options: Allow multiple --key parameters.", 2019-11-28) enabled multi-key support for the C-language tools only. C-language tools parse the "--key" option as follows: OPTION_key [options/options.h] key_store_add_from_selector() [options/keys.c] key_store_import_key() [options/keys.c] And the last function above simply appends the imported key to the keystore. However, commit c10c8baedb88 was ineffective (already at the time of writing) for OCaml-language tools. From commit f84d95474ccf ("Introduce a --key option in tools that accept keys", 2018-09-21), OCaml tools first de-duplicate the "--key" options (using the device identifier as a hash table key), and only (distinct) elements of the flattened hash table are passed to key_store_import_key(): parse_key_selector [mltools/tools_utils.ml] Hashtbl.replace inspect_decrypt [mltools/tools_utils.ml] Hashtbl.fold c_inspect_decrypt [mltools/tools_utils.ml] guestfs_int_mllib_inspect_decrypt [mltools/tools_utils-c.c] key_store_import_key() [options/keys.c] This problem can be demonstrated by passing two keys, a good one and a wrong one, for the same device identifier, to a C-language guestfs tool (such as virt-cat), and to an OCaml-language one (such as virt-get-kernel). The latter is sensitive to the order of "--key" options: $ virt-cat \ --key /dev/sda2:key:good-key \ --key /dev/sda2:key:wrong-key \ -d DOMAIN \ /no-such-file Here the wrong key (passed as the 2nd "--key" option) does not invalidate the first (good) key. $ virt-get-kernel \ --key /dev/sda2:key:good-key \ --key /dev/sda2:key:wrong-key \ -d DOMAIN \ -o /tmp Here the wrong key replaces the good key. $ virt-get-kernel \ --key /dev/sda2:key:wrong-key \ --key /dev/sda2:key:good-key \ -d DOMAIN \ -o /tmp Reversing the order of "--key" options for the OCaml-language tool allows the good key to prevail (and the wrong to be overwritten). Fix this discrepancy by replacing the hash table with a plain list (reference). (Side comment: the hash table-based deduplication didn't do its job entirely, either. We could still pass two keys for the same LUKS block device: once by pathname, and another time by LUKS UUID.) Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=1809453 Signed-off-by: Laszlo Ersek <lersek(a)redhat.com&gt; --- mltools/tools_utils.ml | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/mltools/tools_utils.ml b/mltools/tools_utils.ml index 8508534e16ee..6006ab7e4f6c 100644 --- a/mltools/tools_utils.ml +++ b/mltools/tools_utils.ml @@ -27,11 +27,11 @@ open Getopt.OptionName * messages. *) let prog = ref prog type key_store = { - keys : (string, key_store_key) Hashtbl.t; + keys : (string * key_store_key) list ref; } and key_store_key = | KeyString of string | KeyFileName of string @@ -374,11 +374,11 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) | n -> error (f_"invalid output for --machine-readable: %s") fmt ) in let ks = { - keys = Hashtbl.create 13; + keys = ref []; } in let argspec = ref argspec in let add_argspec = List.push_back argspec in add_argspec ([ S 'V'; L"version" ], Getopt.Unit print_version_and_exit, s_"Display version and exit"); @@ -393,13 +393,13 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) if key_opts then ( let parse_key_selector arg = let parts = String.nsplit ~max:3 ":" arg in match parts with | [ device; "key"; key ] -> - Hashtbl.replace ks.keys device (KeyString key) + List.push_back ks.keys (device, KeyString key) | [ device; "file"; file ] -> - Hashtbl.replace ks.keys device (KeyFileName file) + List.push_back ks.keys (device, KeyFileName file) | _ -> error (f_"invalid selector string for --key: %s") arg in add_argspec ([ L"echo-keys" ], Getopt.Unit c_set_echo_keys, s_"Don’t turn off echo for passphrases"); @@ -680,24 +680,17 @@ let is_btrfs_subvolume g fs = with Guestfs.Error msg as exn -> if g#last_errno () = Guestfs.Errno.errno_EINVAL then false else raise exn let inspect_decrypt g ks = - (* Turn the keys in the key_store into a simpler struct, so it is possible - * to read it using the C API. - *) - let keys_as_list = Hashtbl.fold ( - fun k v acc -> - (k, v) :: acc - ) ks.keys [] in (* Note we pass original 'g' even though it is not used by the * callee. This is so that 'g' is kept as a root on the stack, and * so cannot be garbage collected while we are in the c_inspect_decrypt * function. *) c_inspect_decrypt g#ocaml_handle (Guestfs.c_pointer g#ocaml_handle) - keys_as_list + !(ks.keys) let with_timeout op timeout ?(sleep = 2) fn = let start_t = Unix.gettimeofday () in let rec loop () = if Unix.gettimeofday () -. start_t > float_of_int timeout then -- 2.19.1.3.g30247aa5d201