]>
Dogcows Code - chaz/p5-File-KDBX/blob - t/database.t
11 use File
::KDBX
::Constants
qw(:cipher :version);
13 use File
::Temp
qw(tempfile);
15 use Test
::More
1.001004_001
;
18 subtest
'Create a new database' => sub {
19 my $kdbx = File
::KDBX-
>new;
21 $kdbx->add_group(name
=> 'Meh');
22 ok
$kdbx->_has_implicit_root, 'Database starts off with implicit root';
24 my $entry = $kdbx->add_entry({
26 password
=> {value
=> 'This is a secret!!!!!', protect
=> 1},
29 ok
!$kdbx->_has_implicit_root, 'Adding an entry to the root group makes it explicit';
32 ok
$kdbx->_has_implicit_root, 'Removing group makes the root group implicit again';
34 cmp_ok
$kdbx->version, '==', KDBX_VERSION_3_1
, 'Default KDBX file version is 3.1';
35 is $kdbx->cipher_id, CIPHER_UUID_AES256
, 'Cipher of new database is AES256';
36 cmp_ok
length($kdbx->encryption_iv), '==', 16, 'Encryption IV of new databse is 16 bytes';
38 my $kdbx2 = File
::KDBX-
>new(version
=> KDBX_VERSION_4_0
);
39 is $kdbx2->cipher_id, CIPHER_UUID_CHACHA20
, 'Cipher of new v4 database is ChaCha20';
40 cmp_ok
length($kdbx2->encryption_iv), '==', 12, 'Encryption IV of new databse is 12 bytes';
43 subtest
'Clone' => sub {
44 my $kdbx = File
::KDBX-
>new;
45 $kdbx->add_group(name
=> 'Passwords')->add_entry(title
=> 'My Entry');
47 my $copy = $kdbx->clone;
48 cmp_deeply
$copy, $kdbx, 'Clone keeps the same structure and data' or dumper
$copy;
50 isnt
$kdbx, $copy, 'Clone is a different object';
51 isnt
$kdbx->root, $copy->root,
52 'Clone root group is a different object';
53 isnt
$kdbx->root->groups->[0], $copy->root->groups->[0],
54 'Clone group is a different object';
55 isnt
$kdbx->root->groups->[0]->entries->[0], $copy->root->groups->[0]->entries->[0],
56 'Clone entry is a different object';
58 my @objects = $copy->objects->each;
59 subtest
'Cloned objects refer to the cloned database' => sub {
60 plan tests
=> scalar @_;
62 my $object_kdbx = eval { $object->kdbx };
63 is $object_kdbx, $copy, 'Object: ' . $object->label;
68 subtest
'Iteration algorithm' => sub {
77 my $kdbx = File
::KDBX-
>new;
78 my $group1 = $kdbx->add_group(label
=> 'Group1');
79 my $group2 = $group1->add_group(label
=> 'Group2');
80 my $group3 = $kdbx->add_group(label
=> 'Group3');
81 my $entry1 = $group1->add_entry(label
=> 'EntryA');
82 my $entry2 = $group2->add_entry(label
=> 'EntryB');
83 my $entry3 = $group3->add_entry(label
=> 'EntryC');
85 cmp_deeply
$kdbx->groups->map(sub { $_->label })->to_array,
86 [qw(Root Group1 Group2 Group3)], 'Default group order';
87 cmp_deeply
$kdbx->entries->map(sub { $_->label })->to_array,
88 [qw(EntryA EntryB EntryC)], 'Default entry order';
89 cmp_deeply
$kdbx->objects->map(sub { $_->label })->to_array,
90 [qw(Root Group1 EntryA Group2 EntryB Group3 EntryC)], 'Default object order';
92 cmp_deeply
$kdbx->groups(algorithm
=> 'ids')->map(sub { $_->label })->to_array,
93 [qw(Root Group1 Group2 Group3)], 'IDS group order';
94 cmp_deeply
$kdbx->entries(algorithm
=> 'ids')->map(sub { $_->label })->to_array,
95 [qw(EntryA EntryB EntryC)], 'IDS entry order';
96 cmp_deeply
$kdbx->objects(algorithm
=> 'ids')->map(sub { $_->label })->to_array,
97 [qw(Root Group1 EntryA Group2 EntryB Group3 EntryC)], 'IDS object order';
99 cmp_deeply
$kdbx->groups(algorithm
=> 'dfs')->map(sub { $_->label })->to_array,
100 [qw(Group2 Group1 Group3 Root)], 'DFS group order';
101 cmp_deeply
$kdbx->entries(algorithm
=> 'dfs')->map(sub { $_->label })->to_array,
102 [qw(EntryB EntryA EntryC)], 'DFS entry order';
103 cmp_deeply
$kdbx->objects(algorithm
=> 'dfs')->map(sub { $_->label })->to_array,
104 [qw(Group2 EntryB Group1 EntryA Group3 EntryC Root)], 'DFS object order';
106 cmp_deeply
$kdbx->groups(algorithm
=> 'bfs')->map(sub { $_->label })->to_array,
107 [qw(Root Group1 Group3 Group2)], 'BFS group order';
108 cmp_deeply
$kdbx->entries(algorithm
=> 'bfs')->map(sub { $_->label })->to_array,
109 [qw(EntryA EntryC EntryB)], 'BFS entry order';
110 cmp_deeply
$kdbx->objects(algorithm
=> 'bfs')->map(sub { $_->label })->to_array,
111 [qw(Root Group1 EntryA Group3 EntryC Group2 EntryB)], 'BFS object order';
114 subtest
'Recycle bin' => sub {
115 my $kdbx = File
::KDBX-
>new;
116 my $entry = $kdbx->add_entry(label
=> 'Meh');
118 my $bin = $kdbx->groups->grep(name
=> 'Recycle Bin')->next;
119 ok
!$bin, 'New database has no recycle bin';
121 is $kdbx->recycle_bin_enabled, 1, 'Recycle bin is enabled';
122 $kdbx->recycle_bin_enabled(0);
124 $entry->recycle_or_remove;
125 cmp_ok
$entry->is_recycled, '==', 0, 'Entry is not recycle if recycle bin is disabled';
127 $bin = $kdbx->groups->grep(name
=> 'Recycle Bin')->next;
128 ok
!$bin, 'Recycle bin not autovivified if recycle bin is disabled';
129 is $kdbx->entries->size, 0, 'Database is empty after removing entry';
131 $kdbx->recycle_bin_enabled(1);
133 $entry = $kdbx->add_entry(label
=> 'Another one');
134 $entry->recycle_or_remove;
135 cmp_ok
$entry->is_recycled, '==', 1, 'Entry is recycled';
137 $bin = $kdbx->groups->grep(name
=> 'Recycle Bin')->next;
138 ok
$bin, 'Recycle bin group autovivifies';
139 cmp_ok
$bin->icon_id, '==', 43, 'Recycle bin has the trash icon';
140 cmp_ok
$bin->enable_auto_type, '==', 0, 'Recycle bin has auto type disabled';
141 cmp_ok
$bin->enable_searching, '==', 0, 'Recycle bin has searching disabled';
143 is $kdbx->entries->size, 1, 'Database is not empty';
144 is $kdbx->entries(searching
=> 1)->size, 0, 'Database has no entries if searching';
145 cmp_ok
$bin->all_entries->size, '==', 1, 'Recycle bin has an entry';
147 $entry->recycle_or_remove;
148 is $kdbx->entries->size, 0, 'Remove entry if it is already in the recycle bin';
151 subtest
'Maintenance' => sub {
152 my $kdbx = File
::KDBX-
>new;
154 $kdbx->add_group->add_group;
155 my $entry = $kdbx->add_group->add_entry;
157 cmp_ok
$kdbx->remove_empty_groups, '==', 3, 'Remove two empty groups';
158 cmp_ok
$kdbx->groups->count, '==', 2, 'Two groups remain';
162 cmp_ok
$kdbx->prune_history(max_age
=> 5), '==', 0, 'Do not remove new historical entries';
166 $entry->history->[0]->last_modification_time(scalar gmtime - 86400 * 10);
167 cmp_ok
$kdbx->prune_history(max_age
=> 5), '==', 1, 'Remove a historical entry';
168 cmp_ok
scalar @{$entry->history}, '==', 1, 'One historical entry remains';
170 cmp_ok
$kdbx->remove_unused_icons, '==', 0, 'No icons to remove';
171 $kdbx->add_custom_icon('fake image 1');
172 $kdbx->add_custom_icon('fake image 2');
173 $entry->custom_icon('fake image 3');
174 cmp_ok
$kdbx->remove_unused_icons, '==', 2, 'Remove unused icons';
175 cmp_ok
scalar @{$kdbx->custom_icons}, '==', 1, 'Only one icon remains';
177 my $icon_uuid = $kdbx->add_custom_icon('fake image');
178 $entry->custom_icon('fake image');
179 cmp_ok
$kdbx->remove_duplicate_icons, '==', 1, 'Remove duplicate icons';
180 is $entry->custom_icon_uuid, $icon_uuid, 'Uses of removed icon change';
183 subtest
'Dumping to filesystem' => sub {
184 my $kdbx = File
::KDBX-
>new;
185 $kdbx->add_entry(title
=> 'Foo', password
=> 'whatever');
187 my ($fh, $filepath) = tempfile
('kdbx-XXXXXX', TMPDIR
=> 1, UNLINK
=> 1);
190 $kdbx->dump($filepath, 'a');
192 my $kdbx2 = File
::KDBX-
>load($filepath, 'a');
193 my $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next;
194 is $entry, 'Foo/whatever', 'Dump and load an entry';
196 $kdbx->dump($filepath, key
=> 'a', atomic
=> 0);
198 $kdbx2 = File
::KDBX-
>load($filepath, 'a');
199 $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next;
200 is $entry, 'Foo/whatever', 'Dump and load an entry (non-atomic)';
This page took 0.052483 seconds and 4 git commands to generate.