]>
Dogcows Code - chaz/p5-File-KDBX/blob - t/memory-protection.t
9 use Crypt
::Digest
qw(digest_data);
10 use Crypt
::PRNG
qw(random_bytes);
11 use Crypt
::Misc
qw(decode_b64);
13 use File
::KDBX
::Util
qw(:erase :load);
16 use List
::Util
qw(max);
18 use Scalar
::Util
qw(looks_like_number);
23 if (!$ENV{AUTHOR_TESTING
}) {
24 plan skip_all
=> 'AUTHOR_TESTING required to test memory protection';
27 if (!can_fork
|| !try_load_optional
('POSIX::1003')) {
28 plan skip_all
=> 'fork and POSIX::1003 required to test memory protection';
31 POSIX
::1003->import(':rlimit');
34 my $BLOCK_SIZE = 8196;
36 -e
'core' && die "Remove or move the core dump!\n";
37 my $cleanup = Scope
::Guard-
>new(sub { unlink('core') });
39 my ($cur, $max, $success) = getrlimit
('RLIMIT_CORE');
40 $success or die "getrlimit failed: $!\n";
42 setrlimit('RLIMIT_CORE', RLIM_INFINITY, RLIM_INFINITY) or die "setrlimit failed: $!\n";
45 my $SECRET = 'c3VwZXJjYWxpZnJhZ2lsaXN0aWM=';
46 my $SECRET_SHA256 = 'y1cOWidI80n5EZQx24NrOiP9tlca/uNMBDLYciDyQxs=';
50 test => 'secret in scope',
52 my $secret = decode_b64($SECRET);
60 test => 'erased secret',
62 my $secret = decode_b64($SECRET);
71 test => 'Key password',
73 my $password = decode_b64($SECRET);
74 my $key = File::KDBX::Key->new($password);
83 test => 'Key password, raw key shown',
85 my $password = decode_b64($SECRET);
86 my $key = File::KDBX::Key->new($password);
97 test => 'Key password, raw key hidden',
99 my $password = decode_b64($SECRET);
100 my $key = File::KDBX::Key->new($password);
102 $key->show->hide for 0..500;
111 test => 'protected strings and keys',
113 my $kdbx = File::KDBX->load(testfile('MemoryProtection.kdbx'), 'masterpw');
117 'TXkgcGFzc3dvcmQgaXMgYSBzZWNyZXQgdG8gZXZlcnlvbmUu' => 0, # Password
118 'QSB0cmVhc3VyZSBtYXAgaXMgb24gdGhlIGJhY2sgb2YgdGhlIERlY2xhcmF0aW9uIG9mIEluZGVwZW5kZW5jZS4=' => 0,
120 'SmVmZnJleSBFcHN0ZWluIGRpZG4ndCBraWxsIGhpbXNlbGYu' => 0, # Secret B
121 'c3VwZXJjYWxpZnJhZ2lsaXN0aWNleHBpYWxpZG9jaW91cw==' => 1, # Nonsecret
122 'SlHA3Eyhomr/UQ6vznWMRZtxlrqIm/tM3qVZv7G31DU=' => 0, # Final key
123 'LuVqNfGluvLPcg2W699/Q6WGxIztX7Jvw0ONwQEi/Jc=' => 0, # Transformed key
125 'kDEMVEcGR32UXTwG8j3SxsfdF+l124Ni6iHeogCWGd2z0KSG5PosDTloxC0zg7Ucn2CNR6f2wpgzcVGKmDNFCA==' => 0,
126 # Inner random stream key:
127 'SwJSukmQdZKpHm8PywqLu1EHfUzS/gyJsg61Cm74YeRJeOpDlFblbVd5d4p+lU2/7Q28Vk4j/E2RRMC81DXdUw==' => 1,
128 'RREzJd4fKHtFkjRIi+xucGPW2q+mov+LRWL4RkPql7Y=' => 1, # Random stream key (actual)
132 test => 'inner random stream key replaced',
134 my $kdbx = File::KDBX->load(testfile('MemoryProtection.kdbx'), 'masterpw');
135 $kdbx->inner_random_stream_key("\1" x 64);
139 # Inner random stream key:
140 # FIXME - there is second copy of this key somewhere... in another SvPV?
141 'SwJSukmQdZKpHm8PywqLu1EHfUzS/gyJsg61Cm74YeRJeOpDlFblbVd5d4p+lU2/7Q28Vk4j/E2RRMC81DXdUw==' => undef,
145 test => 'protected strings revealed',
147 my $kdbx = File::KDBX->load(testfile('MemoryProtection.kdbx'), 'masterpw');
152 'TXkgcGFzc3dvcmQgaXMgYSBzZWNyZXQgdG8gZXZlcnlvbmUu' => 1, # Password
154 'QSB0cmVhc3VyZSBtYXAgaXMgb24gdGhlIGJhY2sgb2YgdGhlIERlY2xhcmF0aW9uIG9mIEluZGVwZW5kZW5jZS4=' => 1,
155 'SmVmZnJleSBFcHN0ZWluIGRpZG4ndCBraWxsIGhpbXNlbGYu' => 1, # Secret B
156 'c3VwZXJjYWxpZnJhZ2lsaXN0aWNleHBpYWxpZG9jaW91cw==' => 1, # Nonsecret
157 'RREzJd4fKHtFkjRIi+xucGPW2q+mov+LRWL4RkPql7Y=' => 0, # Random stream key (actual)
161 test => 'protected strings previously-revealed',
163 my $kdbx = File::KDBX->load(testfile('MemoryProtection.kdbx'), 'masterpw');
169 'TXkgcGFzc3dvcmQgaXMgYSBzZWNyZXQgdG8gZXZlcnlvbmUu' => 0, # Password
171 'QSB0cmVhc3VyZSBtYXAgaXMgb24gdGhlIGJhY2sgb2YgdGhlIERlY2xhcmF0aW9uIG9mIEluZGVwZW5kZW5jZS4=' => 0,
172 'SmVmZnJleSBFcHN0ZWluIGRpZG4ndCBraWxsIGhpbXNlbGYu' => 0, # Secret B
173 'c3VwZXJjYWxpZnJhZ2lsaXN0aWNleHBpYWxpZG9jaW91cw==' => 1, # Nonsecret
174 'RREzJd4fKHtFkjRIi+xucGPW2q+mov+LRWL4RkPql7Y=' => 0, # Random stream key (actual)
178 my ($description, $run, $strings) = @$test{qw(test run strings)};
180 subtest
"Dump core with $description" => sub {
182 my $num_strings = @strings / 2;
183 plan tests
=> 2 + $num_strings * 2;
185 my (@encoded_strings, @expected);
187 my ($string, $expected) = splice @strings, 0, 2;
188 push @encoded_strings, $string;
189 push @expected, $expected;
192 my ($dumped, $has_core, @matches) = run_test
($run, @encoded_strings);
194 ok
$dumped, 'Test process signaled that it core-dumped';
195 ok
$has_core, 'Found core dump' or return;
197 note
sprintf('core dump is %.1f MiB', (-s
'core')/1048576);
199 for (my $i = 1; $i <= $num_strings; ++$i) {
200 my $count = $matches[$i - 1];
201 my $string = $encoded_strings[$i - 1];
202 my $expected = $expected[$i - 1];
204 ok
defined $count, "[#$i] Got result from test environment";
207 local $TODO = 'Unprotected memory!' if !defined $expected;
209 ok
0 < $count, "[#$i] String FOUND"
210 or diag
"Found $count copies of string #$i\nString: $string";
213 is $count, 0, "[#$i] String MISSING"
214 or diag
"Found $count copies of string #$i\nString: $string";
224 ##############################################################################
226 sub dump_core
{ kill 'QUIT', $$ }
229 my $filepath = shift;
233 my %counts = map { $_ => $counter++ } @strings;
234 my @counts = map { 0 } @strings;
236 my $pattern = join('|', map { quotemeta($_) } @strings);
238 my $overlap = (max
map { length } @strings) - 1;
240 open(my $fh, '<:raw', $filepath) or die "open failed: $!\n";
243 while (read $fh, my $block, $BLOCK_SIZE) {
244 substr($block, 0, 0, substr($previous, -$overlap)) if defined $previous;
246 while ($block =~ /($pattern)/gs) {
247 ++$counts[$counts{$1}];
249 $previous = substr($block, $overlap);
251 die "read error: $!" if $fh->error;
260 my $seed = random_bytes
(32);
262 pipe(my $read, my $write) or die "pipe failed: $!\n";
264 defined(my $pid = fork) or die "fork failed: $!\n";
268 my $exit_status = run_doomed_child
($code, $seed);
269 my $dumped = $exit_status & 127 && $exit_status & 128;
271 my @decoded_strings = map { decode_b64
($_) } @strings;
273 my @matches = file_grep
('core', @decoded_strings);
274 print $write join('|', $dumped, -f
'core' ? 1 : 0, @matches);
281 my $results = do { local $/; <$read> };
284 my $exit_status = $? >> 8;
285 $exit_status == 0 or die "test environment exited non-zero: $exit_status\n";
287 return split(/\|/, $results);
290 sub run_doomed_child
{
294 unlink('core') or die "unlink failed: $!\n" if -f
'core';
296 defined(my $pid = fork) or die "fork failed: $!\n";
299 dump_core
(); # doomed
300 POSIX
::_exit
(1); # paranoid
This page took 0.055509 seconds and 4 git commands to generate.