]>
Dogcows Code - chaz/p5-File-KDBX/blob - kdb.t
ab4fea47818f838394d3a9fef6826b3280583add
14 eval { require File
::KeePass
; require File
::KeePass
::KDBX
}
15 or plan skip_all
=> 'File::KeePass and File::KeePass::KDBX required to test KDB files';
17 my $kdbx = File
::KDBX-
>load(testfile
('basic.kdb'), 'masterpw');
22 cmp_deeply
$kdbx->headers, superhashof
({
23 cipher_id
=> "1\301\362\346\277qCP\276X\5!j\374Z\377",
24 encryption_iv
=> "\250\354q\362\13\247\353\247\222!\232\364Lj\315w",
25 master_seed
=> "\212z\356\256\340+\n\243ms2\364'!7\216",
26 transform_rounds
=> 713,
27 transform_seed
=> "\227\264\n^\230\2\301:!f\364\336\251\277\241[\3`\314RG\343\16U\333\305eT3:\240\257",
28 }), 'Get expected headers from KDB file' or diag explain
$kdbx->headers;
30 is keys %{$kdbx->deleted_objects}, 0, 'There are no deleted objects';
31 is scalar @{$kdbx->root->groups}, 2, 'Root group has two children.';
33 my $group1 = $kdbx->root->groups->[0];
34 isnt
$group1->uuid, undef, 'Group 1 has a UUID';
35 is $group1->name, 'Internet', 'Group 1 has a name';
36 is scalar @{$group1->groups}, 2, 'Group 1 has subgroups';
37 is scalar @{$group1->entries}, 2, 'Group 1 has entries';
38 is $group1->icon_id, 1, 'Group 1 has an icon';
40 my ($entry11, $entry12, @other) = @{$group1->entries};
42 isnt
$entry11->uuid, undef, 'Entry has a UUID';
43 is $entry11->title, 'Test entry', 'Entry has a title';
44 is $entry11->icon_id, 1, 'Entry has an icon';
45 is $entry11->username, 'I', 'Entry has a username';
46 is $entry11->url, 'http://example.com/', 'Entry has a URL';
47 is $entry11->password, 'secretpassword', 'Entry has a password';
48 is $entry11->notes, "Lorem ipsum\ndolor sit amet", 'Entry has notes';
49 ok
$entry11->expires, 'Entry is expired';
50 is $entry11->expiry_time, 'Wed May 9 10:32:00 2012', 'Entry has an expiration time';
51 is scalar keys %{$entry11->binaries}, 1, 'Entry has a binary';
52 is $entry11->binary_value('attachment.txt'), "hello world\n", 'Entry has a binary';
54 is $entry12->title, '', 'Entry 2 has an empty title';
55 is $entry12->icon_id, 0, 'Entry 2 has an icon';
56 is $entry12->username, '', 'Entry 2 has an empty username';
57 is $entry12->url, '', 'Entry 2 has an empty URL';
58 is $entry12->password, '', 'Entry 2 has an empty password';
59 is $entry12->notes, '', 'Entry 2 has empty notes';
60 ok
!$entry12->expires, 'Entry 2 is not expired';
61 is scalar keys %{$entry12->binaries}, 0, 'Entry has no binaries';
63 my $group11 = $group1->groups->[0];
64 is $group11->label, 'Subgroup 1', 'Group has subgroup';
65 is scalar @{$group11->groups}, 1, 'Subgroup has subgroup';
67 my $group111 = $group11->groups->[0];
68 is $group111->label, 'Unexpanded', 'Has unexpanded group';
69 is scalar @{$group111->groups}, 1, 'Subgroup has subgroup';
71 my $group1111 = $group111->groups->[0];
72 is $group1111->label, 'abc', 'Group has subsubsubroup';
73 is scalar @{$group1111->groups}, 0, 'No more subgroups';
75 my $group12 = $group1->groups->[1];
76 is $group12->label, 'Subgroup 2', 'Group has another subgroup';
77 is scalar @{$group12->groups}, 0, 'No more subgroups';
79 my $group2 = $kdbx->root->groups->[1];
80 is $group2->label, 'eMail', 'Root has another subgroup';
81 is scalar @{$group2->entries}, 1, 'eMail group has an entry';
82 is $group2->icon_id, 19, 'Group has a standard icon';
86 ['Basic after dump & load roundtrip'
87 => File
::KDBX-
>load_string($kdbx->dump_string('a', randomize_seeds
=> 0), 'a')],
89 my ($name, $kdbx) = @$test;
90 subtest
$name, \
&test_basic
, $kdbx;
93 sub test_custom_icons
{
96 my ($uuid, @other) = keys %{$kdbx->custom_icons};
97 ok
$uuid, 'Database has a custom icon';
98 is scalar @other, 0, 'Database has no other icons';
100 my $data = $kdbx->custom_icon_data($uuid);
101 like
$data, qr/^\x89PNG\r\n/, 'Custom icon is a PNG';
104 ['Custom icons' => $kdbx],
105 ['Custom icons after dump & load roundtrip'
106 => File
::KDBX-
>load_string($kdbx->dump_string('a', upgrade
=> 0, randomize_seeds
=> 0), 'a')],
108 my ($name, $kdbx) = @$test;
109 subtest
$name, \
&test_custom_icons
, $kdbx;
112 subtest
'Group expansion' => sub {
113 is $kdbx->root->groups->[0]->is_expanded, 1, 'Group is expanded';
114 is $kdbx->root->groups->[0]->groups->[0]->is_expanded, 1, 'Subgroup is expanded';
115 is $kdbx->root->groups->[0]->groups->[0]->groups->[0]->is_expanded, 0, 'Subsubgroup is not expanded';
118 subtest
'Autotype' => sub {
119 my $group = $kdbx->root->groups->[0]->groups->[0];
120 is scalar @{$group->entries}, 2, 'Group has two entries';
122 my ($entry1, $entry2) = @{$group->entries};
124 is $entry1->notes, "\nlast line", 'First entry has a note';
126 local $TODO = 'File::KeePass fails to parse out the default key sequence';
127 is $entry1->auto_type->{default_sequence
}, '{USERNAME}{ENTER}', 'First entry has a default sequence';
129 cmp_deeply
$entry1->auto_type->{associations
}, set
(
131 keystroke_sequence
=> "{USERNAME}{ENTER}",
132 window
=> "a window",
135 keystroke_sequence
=> "{USERNAME}{ENTER}",
136 window
=> "a second window",
139 keystroke_sequence
=> "{PASSWORD}{ENTER}",
140 window
=> "Window Nr 1a",
143 keystroke_sequence
=> "{PASSWORD}{ENTER}",
144 window
=> "Window Nr 1b",
147 keystroke_sequence
=> "{USERNAME}{ENTER}",
148 window
=> "Window 2",
150 ), 'First entry has auto-type window associations';
152 is $entry2->notes, "start line\nend line", 'Second entry has notes';
154 local $TODO = 'File::KeePass fails to parse out the default key sequence';
155 is $entry2->auto_type->{default_sequence
}, '', 'Second entry has no default sequence';
156 cmp_deeply
$entry2->auto_type->{associations
}, set
(
158 keystroke_sequence
=> "",
159 window
=> "Main Window",
162 keystroke_sequence
=> "",
163 window
=> "Test Window",
165 ), 'Second entry has auto-type window associations' or diag explain
$entry2->auto_type->{associations
};
169 subtest
'KDB file keys' => sub {
171 my ($name, $key) = splice @_, 0, 2;
172 my $kdb_filepath = testfile
("$name.kdb");
173 my $kdbx = File
::KDBX-
>load($kdb_filepath, $key);
175 is $kdbx->root->name, $name, "Loaded KDB database with root group is named $name";
178 FileKeyBinary
=> {file
=> testfile
('FileKeyBinary.key')},
179 FileKeyHex
=> {file
=> testfile
('FileKeyHex.key')},
180 FileKeyHashed
=> {file
=> testfile
('FileKeyHashed.key')},
181 CompositeKey
=> ['mypassword', {file
=> testfile
('FileKeyHex.key')}],
184 subtest
'Twofish' => sub {
185 plan skip_all
=> 'File::KeePass does not implement the Twofish cipher';
186 my $name = 'Twofish';
187 my $kdbx = File
::KDBX-
>load(testfile
("$name.kdb"), 'masterpw');
188 is $kdbx->root->name, $name, "Loaded KDB database with root group is named $name";
191 subtest
'CP-1252 password' => sub {
192 my $name = 'CP-1252';
193 my $kdbx = File
::KDBX-
>load(testfile
("$name.kdb"),
194 decode
('UTF-8', "\xe2\x80\x9e\x70\x61\x73\x73\x77\x6f\x72\x64\xe2\x80\x9d"));
195 is $kdbx->root->name, $name, "Loaded KDB database with root group is named $name";
This page took 0.050115 seconds and 3 git commands to generate.