Dogcows Code - chaz/p5-File-KDBX/blob - t/kdbx4.t

   1 #!/usr/bin/env perl
   2
   3 use utf8;
   4 use warnings;
   5 use strict;
   6
   7 use lib 't/lib';
   8 use TestCommon;
   9
  10 use File::KDBX;
  11 use File::KDBX::Constants qw(:version :kdf);
  12 use Test::Deep;
  13 use Test::More 1.001004_001;
  14 use boolean qw(:all);
  15
  16 subtest 'Verify Format400' => sub {
  17     my $kdbx = File::KDBX->load(testfile('Format400.kdbx'), 't');
  18     $kdbx->unlock;
  19
  20     ok_magic $kdbx, KDBX_VERSION_4_0, 'Get the correct KDBX4 file magic';
  21
  22     cmp_deeply $kdbx->headers, {
  23         cipher_id => "\326\3\212+\213oL\265\245\$3\2321\333\265\232",
  24         compression_flags => 1,
  25         encryption_iv => "3?\207P\233or\220\215h\2240",
  26         kdf_parameters => {
  27             "\$UUID" => "\357cm\337\214)DK\221\367\251\244\3\343\n\f",
  28             I => num(2),
  29             M => num(1048576),
  30             P => num(2),
  31             S => "V\254\6m-\206*\260\305\f\0\366\24:4\235\364A\362\346\221\13)}\250\217P\303\303\2\331\245",
  32             V => num(19),
  33         },
  34         master_seed => ";\372y\300yS%\3331\177\231\364u\265Y\361\225\3273h\332R,\22\240a\240\302\271\357\313\23",
  35     }, 'Extract headers' or diag explain $kdbx->headers;
  36
  37     is $kdbx->transform_seed,
  38         "V\254\6m-\206*\260\305\f\0\366\24:4\235\364A\362\346\221\13)}\250\217P\303\303\2\331\245",
  39         'Get the correct transform seed';
  40     cmp_ok $kdbx->transform_rounds, '==', 2, 'Get the correct transform rounds';
  41
  42     is $kdbx->meta->{database_name}, 'Format400', 'Extract database name from meta';
  43     is $kdbx->root->name, 'Format400', 'Extract name of root group';
  44
  45     my ($entry, @other) = $kdbx->entries->grep(\'400', 'title')->each;
  46     is scalar @other, 0, 'Database has one entry';
  47
  48     is $entry->title, 'Format400', 'Entry is titled';
  49     is $entry->username, 'Format400', 'Entry has a username set';
  50     is keys %{$entry->strings}, 6, 'Entry has six strings';
  51     is $entry->string_value('Format400'), 'Format400', 'Entry has a custom string';
  52     is keys %{$entry->binaries}, 1, 'Entry has one binary';
  53     is $entry->binary_value('Format400'), "Format400\n", 'Entry has a binary string';
  54 };
  55
  56 subtest 'KDBX4 upgrade' => sub {
  57     my $kdbx = File::KDBX->new;
  58
  59     $kdbx->kdf_parameters->{+KDF_PARAM_UUID} = KDF_UUID_AES_CHALLENGE_RESPONSE;
  60     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'AES challenge-response KDF requires upgrade';
  61     $kdbx->kdf_parameters->{+KDF_PARAM_UUID} = KDF_UUID_ARGON2D;
  62     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'Argon2D KDF requires upgrade';
  63     $kdbx->kdf_parameters->{+KDF_PARAM_UUID} = KDF_UUID_ARGON2ID;
  64     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'Argon2ID KDF requires upgrade';
  65     $kdbx->kdf_parameters->{+KDF_PARAM_UUID} = KDF_UUID_AES;
  66     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
  67
  68     $kdbx->public_custom_data->{foo} = 42;
  69     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'Public custom data requires upgrade';
  70     delete $kdbx->public_custom_data->{foo};
  71     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
  72
  73     my $entry = $kdbx->add_entry;
  74     $entry->custom_data(foo => 'bar');
  75     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'Entry custom data requires upgrade';
  76     delete $entry->custom_data->{foo};
  77     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
  78
  79     my $group = $kdbx->add_group;
  80     $group->custom_data(foo => 'bar');
  81     is $kdbx->minimum_version, KDBX_VERSION_4_0, 'Group custom data requires upgrade';
  82     delete $group->custom_data->{foo};
  83     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
  84 };
  85
  86 subtest 'KDBX4.1 upgrade' => sub {
  87     my $kdbx = File::KDBX->new;
  88
  89     my $group1 = $kdbx->add_group(label => 'One');
  90     my $group2 = $kdbx->add_group(label => 'Two');
  91     my $entry1 = $kdbx->add_entry(label => 'Meh');
  92
  93     $group1->tags('hi');
  94     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Groups with tags requires upgrade';
  95     $group1->tags('');
  96     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
  97
  98     $entry1->quality_check(0);
  99     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Disable entry quality check requires upgrade';
 100     $entry1->quality_check(1);
 101     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 102
 103     $group1->previous_parent_group($group2->uuid);
 104     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Previous parent group on group requires upgrade';
 105     $group1->previous_parent_group(undef);
 106     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 107
 108     $entry1->previous_parent_group($group2->uuid);
 109     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Previous parent group on entry requires upgrade';
 110     $entry1->previous_parent_group(undef);
 111     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 112
 113     $kdbx->add_custom_icon('data');
 114     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Icon with no metadata requires no upgrade';
 115     my $icon_uuid = $kdbx->add_custom_icon('data2', name => 'icon name');
 116     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Icon with name requires upgrade';
 117     $kdbx->remove_custom_icon($icon_uuid);
 118     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 119     $icon_uuid = $kdbx->add_custom_icon('data2', last_modification_time => scalar gmtime);
 120     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Icon with modtime requires upgrade';
 121     $kdbx->remove_custom_icon($icon_uuid);
 122     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 123
 124     $entry1->custom_data(foo => 'bar', last_modification_time => scalar gmtime);
 125     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Entry custom data modtime requires upgrade';
 126     delete $entry1->custom_data->{foo};
 127     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 128
 129     $group1->custom_data(foo => 'bar', last_modification_time => scalar gmtime);
 130     is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Group custom data modtime requires upgrade';
 131     delete $group1->custom_data->{foo};
 132     is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
 133 };
 134
 135 sub test_upgrade_master_key_integrity {
 136     my ($modifier, $expected_version) = @_;
 137     plan tests => $expected_version >= KDBX_VERSION_4_0 ? 6 : 5;
 138
 139     my $kdbx = File::KDBX->new;
 140     is $kdbx->kdf->uuid, KDF_UUID_AES, 'Default KDF is AES';
 141
 142     $kdbx->kdf_parameters(fast_kdf);
 143
 144     {
 145         local $_ = $kdbx;
 146         $modifier->($kdbx);
 147     }
 148     is $kdbx->minimum_version, $expected_version,
 149         sprintf('Got expected minimum version after modification: %x', $kdbx->minimum_version);
 150
 151     my $master_key = ['fffqcvq4rc', \'this is a keyfile', sub { 'chalresp 523rf2' }];
 152     my $dump;
 153     warnings { $kdbx->dump_string(\$dump, $master_key) };
 154     ok $dump, 'Can dump the database' or diag explain $dump;
 155
 156     like exception { File::KDBX->load_string($dump, 'wrong key') },
 157         qr/invalid credentials/i, 'Cannot load a KDBX with the wrong key';
 158
 159     # print STDERR "DUMP: [$dump]\n";
 160
 161     my $kdbx2 = File::KDBX->load_string($dump, $master_key);
 162
 163     is $kdbx2->version, $expected_version, sprintf('Got expected version: %x', $kdbx2->version);
 164     isnt $kdbx2->kdf->uuid, KDF_UUID_AES, 'No unexpected KDF' if $kdbx2->version >= KDBX_VERSION_4_0;
 165
 166     # diag explain(File::KDBX->load_string($dump, $master_key, inner_format => 'Raw')->raw);
 167 }
 168 for my $test (
 169     [KDBX_VERSION_3_1, 'nothing', sub {}],
 170     [KDBX_VERSION_3_1, 'AES KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_AES)) }],
 171     [KDBX_VERSION_4_0, 'Argon2D KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_ARGON2D)) }],
 172     [KDBX_VERSION_4_0, 'Argon2ID KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_ARGON2ID)) }],
 173     [KDBX_VERSION_4_0, 'public custom data', sub { $_->public_custom_data->{foo} = 'bar' }],
 174     [KDBX_VERSION_3_1, 'custom data', sub { $_->custom_data(foo => 'bar') }],
 175     [KDBX_VERSION_4_0, 'root group custom data', sub { $_->root->custom_data(baz => 'qux') }],
 176     [KDBX_VERSION_4_0, 'group custom data', sub { $_->add_group->custom_data(baz => 'qux') }],
 177     [KDBX_VERSION_4_0, 'entry custom data', sub { $_->add_entry->custom_data(baz => 'qux') }],
 178 ) {
 179     my ($expected_version, $name, $modifier) = @$test;
 180     subtest "Master key integrity: $name" => \&test_upgrade_master_key_integrity,
 181         $modifier, $expected_version;
 182 }
 183
 184 subtest 'Custom data' => sub {
 185     my $kdbx = File::KDBX->new;
 186     $kdbx->kdf_parameters(fast_kdf(KDF_UUID_AES));
 187     $kdbx->version(KDBX_VERSION_4_0);
 188
 189     $kdbx->public_custom_data->{str} = '你好';
 190     $kdbx->public_custom_data->{num} = 42;
 191     $kdbx->public_custom_data->{bool} = true;
 192     $kdbx->public_custom_data->{bytes} = "\1\2\3\4";
 193
 194     my $group = $kdbx->add_group(label => 'Group');
 195     $group->custom_data(str => '你好');
 196     $group->custom_data(num => 42);
 197     $group->custom_data(bool => true);
 198
 199     my $entry = $kdbx->add_entry(label => 'Entry');
 200     $entry->custom_data(str => '你好');
 201     $entry->custom_data(num => 42);
 202     $entry->custom_data(bool => false);
 203
 204     my $dump = $kdbx->dump_string('a');
 205     my $kdbx2 = File::KDBX->load_string($dump, 'a');
 206
 207     is $kdbx2->public_custom_data->{str}, '你好', 'Store a string in public custom data';
 208     cmp_ok $kdbx2->public_custom_data->{num}, '==', 42, 'Store a number in public custom data';
 209     is $kdbx2->public_custom_data->{bool}, true, 'Store a boolean in public custom data';
 210     ok isBoolean($kdbx2->public_custom_data->{bool}), 'Boolean is indeed a boolean';
 211     is $kdbx2->public_custom_data->{bytes}, "\1\2\3\4", 'Store some bytes in public custom data';
 212
 213     my $group2 = $kdbx2->groups->grep(label => 'Group')->next;
 214     is_deeply $group2->custom_data_value('str'), '你好', 'Store a string in group custom data';
 215     is_deeply $group2->custom_data_value('num'), '42', 'Store a number in group custom data';
 216     is_deeply $group2->custom_data_value('bool'), '1', 'Store a boolean in group custom data';
 217
 218     my $entry2 = $kdbx2->entries->grep(label => 'Entry')->next;
 219     is_deeply $entry2->custom_data_value('str'), '你好', 'Store a string in entry custom data';
 220     is_deeply $entry2->custom_data_value('num'), '42', 'Store a number in entry custom data';
 221     is_deeply $entry2->custom_data_value('bool'), '0', 'Store a boolean in entry custom data';
 222 };
 223
 224 subtest 'KDF parameters' => sub {
 225     my $kdbx = File::KDBX->new;
 226     $kdbx->version(KDBX_VERSION_4_0);
 227
 228     is $kdbx->kdf_parameters->{+KDF_PARAM_UUID}, KDF_UUID_AES, 'Default KDF type is correct';
 229     cmp_ok $kdbx->transform_rounds, '==', 100_000, 'Default transform rounds is correct';
 230
 231     $kdbx->transform_rounds(17);
 232     cmp_deeply $kdbx->kdf_parameters, {
 233         "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352",
 234         R => num(17),
 235         S => ignore(),
 236     }, 'Set transform rounds for AES KDF';
 237
 238     $kdbx->kdf_parameters({KDF_PARAM_UUID() => KDF_UUID_ARGON2D});
 239     cmp_ok $kdbx->transform_rounds, '==', 10, 'Default Argon2D transform rounds is correct';
 240
 241     $kdbx->transform_rounds(17);
 242     cmp_deeply $kdbx->kdf_parameters, {
 243         "\$UUID" => "\357cm\337\214)DK\221\367\251\244\3\343\n\f",
 244         I => num(17),
 245     }, 'Set transform rounds for Argon KDF';
 246 };
 247
 248 done_testing;