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

[Laszlo Ersek]

On 06/28/22 16:23, Richard W.M. Jones wrote:
> On Tue, Jun 28, 2022 at 01:49:07PM +0200, Laszlo Ersek wrote:
>> 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
>>> libguestfs: error: download: /no-such-file: No such file or directory
>>
>> 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
>>> virt-get-kernel: could not find key to open LUKS encrypted /dev/sda2.
>>>
>>> Try using --key on the command line.
>>>
>>> Original error: cryptsetup_open: cryptsetup exited with status 2: No key
>>> available with this passphrase. (0)
>>
>> 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
>>> download: /boot/vmlinuz-[...] -> /tmp/vmlinuz-[...]
>>> download: /boot/initramfs-[...].img -> /tmp/initramfs-[...].img
>>
>> 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 at redhat.com>
>> ---
>>  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)
> 
> I was _going_ to say you don't need the parentheses here.  Luckily I
> tested it before saying that, and it turns out you do!

When I was first writing it, I said "there's no way I'd need parens
here". The compiler thought different ;)

>>  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
>> -- 
> 
> Reviewed-by: Richard W.M. Jones <rjones at redhat.com>
> 
> 

Thanks!