view release on metacpan or  search on metacpan

t/kdbx4.t  view on Meta::CPAN

    $entry1->quality_check(0);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Disable entry quality check requires upgrade';
    $entry1->quality_check(1);
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';

    $group1->previous_parent_group($group2->uuid);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Previous parent group on group requires upgrade';
    $group1->previous_parent_group(undef);
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';

    $entry1->previous_parent_group($group2->uuid);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Previous parent group on entry requires upgrade';
    $entry1->previous_parent_group(undef);
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';

    $kdbx->add_custom_icon('data');
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Icon with no metadata requires no upgrade';
    my $icon_uuid = $kdbx->add_custom_icon('data2', name => 'icon name');
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Icon with name requires upgrade';
    $kdbx->remove_custom_icon($icon_uuid);
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
    $icon_uuid = $kdbx->add_custom_icon('data2', last_modification_time => scalar gmtime);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Icon with modtime requires upgrade';
    $kdbx->remove_custom_icon($icon_uuid);
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';

    $entry1->custom_data(foo => 'bar', last_modification_time => scalar gmtime);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Entry custom data modtime requires upgrade';
    delete $entry1->custom_data->{foo};
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';

    $group1->custom_data(foo => 'bar', last_modification_time => scalar gmtime);
    is $kdbx->minimum_version, KDBX_VERSION_4_1, 'Group custom data modtime requires upgrade';
    delete $group1->custom_data->{foo};
    is $kdbx->minimum_version, KDBX_VERSION_3_1, 'Reset upgrade requirement';
};

sub test_upgrade_master_key_integrity {
    my ($modifier, $expected_version) = @_;
    plan tests => $expected_version >= KDBX_VERSION_4_0 ? 6 : 5;

    my $kdbx = File::KDBX->new;
    is $kdbx->kdf->uuid, KDF_UUID_AES, 'Default KDF is AES';

    $kdbx->kdf_parameters(fast_kdf);

    {
        local $_ = $kdbx;
        $modifier->($kdbx);
    }
    is $kdbx->minimum_version, $expected_version,
        sprintf('Got expected minimum version after modification: %x', $kdbx->minimum_version);

    my $master_key = ['fffqcvq4rc', \'this is a keyfile', sub { 'chalresp 523rf2' }];
    my $dump;
    warnings { $kdbx->dump_string(\$dump, $master_key) };
    ok $dump, 'Can dump the database' or diag explain $dump;

    like exception { File::KDBX->load_string($dump, 'wrong key') },
        qr/invalid credentials/i, 'Cannot load a KDBX with the wrong key';

    # print STDERR "DUMP: [$dump]\n";

    my $kdbx2 = File::KDBX->load_string($dump, $master_key);

    is $kdbx2->version, $expected_version, sprintf('Got expected version: %x', $kdbx2->version);
    isnt $kdbx2->kdf->uuid, KDF_UUID_AES, 'No unexpected KDF' if $kdbx2->version >= KDBX_VERSION_4_0;

    # diag explain(File::KDBX->load_string($dump, $master_key, inner_format => 'Raw')->raw);
}
for my $test (
    [KDBX_VERSION_3_1, 'nothing', sub {}],
    [KDBX_VERSION_3_1, 'AES KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_AES)) }],
    [KDBX_VERSION_4_0, 'Argon2D KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_ARGON2D)) }],
    [KDBX_VERSION_4_0, 'Argon2ID KDF', sub { $_->kdf_parameters(fast_kdf(KDF_UUID_ARGON2ID)) }],
    [KDBX_VERSION_4_0, 'public custom data', sub { $_->public_custom_data->{foo} = 'bar' }],
    [KDBX_VERSION_3_1, 'custom data', sub { $_->custom_data(foo => 'bar') }],
    [KDBX_VERSION_4_0, 'root group custom data', sub { $_->root->custom_data(baz => 'qux') }],
    [KDBX_VERSION_4_0, 'group custom data', sub { $_->add_group->custom_data(baz => 'qux') }],
    [KDBX_VERSION_4_0, 'entry custom data', sub { $_->add_entry->custom_data(baz => 'qux') }],
) {
    my ($expected_version, $name, $modifier) = @$test;
    subtest "Master key integrity: $name" => \&test_upgrade_master_key_integrity,
        $modifier, $expected_version;
}

subtest 'Custom data' => sub {
    my $kdbx = File::KDBX->new;
    $kdbx->kdf_parameters(fast_kdf(KDF_UUID_AES));
    $kdbx->version(KDBX_VERSION_4_0);

    $kdbx->public_custom_data->{str} = '你好';
    $kdbx->public_custom_data->{num} = 42;
    $kdbx->public_custom_data->{bool} = true;
    $kdbx->public_custom_data->{bytes} = "\1\2\3\4";

    my $group = $kdbx->add_group(label => 'Group');
    $group->custom_data(str => '你好');
    $group->custom_data(num => 42);
    $group->custom_data(bool => true);

    my $entry = $kdbx->add_entry(label => 'Entry');
    $entry->custom_data(str => '你好');
    $entry->custom_data(num => 42);
    $entry->custom_data(bool => false);

    my $dump = $kdbx->dump_string('a');
    my $kdbx2 = File::KDBX->load_string($dump, 'a');

    is $kdbx2->public_custom_data->{str}, '你好', 'Store a string in public custom data';
    cmp_ok $kdbx2->public_custom_data->{num}, '==', 42, 'Store a number in public custom data';
    is $kdbx2->public_custom_data->{bool}, true, 'Store a boolean in public custom data';
    ok isBoolean($kdbx2->public_custom_data->{bool}), 'Boolean is indeed a boolean';
    is $kdbx2->public_custom_data->{bytes}, "\1\2\3\4", 'Store some bytes in public custom data';

    my $group2 = $kdbx2->groups->grep(label => 'Group')->next;
    is_deeply $group2->custom_data_value('str'), '你好', 'Store a string in group custom data';
    is_deeply $group2->custom_data_value('num'), '42', 'Store a number in group custom data';
    is_deeply $group2->custom_data_value('bool'), '1', 'Store a boolean in group custom data';