File Coverage

blib/lib/File/KDBX/KDF/AES.pm
Criterion Covered Total %
statement 52 68 76.4
branch 7 18 38.8
condition 5 12 41.6
subroutine 15 15 100.0
pod 3 3 100.0
total 82 116 70.6


line stmt bran cond sub pod time code
1             package File::KDBX::KDF::AES;
2             # ABSTRACT: Using the AES cipher as a key derivation function
3              
4 11     11   5340 use warnings;
  11         29  
  11         355  
5 11     11   204 use strict;
  11         26  
  11         228  
6              
7 11     11   2759 use Crypt::Cipher;
  11         2024  
  11         288  
8 11     11   714 use Crypt::Digest qw(digest_data);
  11         1198  
  11         575  
9 11     11   59 use File::KDBX::Constants qw(:bool :kdf);
  11         19  
  11         1946  
10 11     11   61 use File::KDBX::Error;
  11         20  
  11         457  
11 11     11   57 use File::KDBX::Util qw(:class :load can_fork);
  11         37  
  11         1281  
12 11     11   68 use namespace::clean;
  11         18  
  11         72  
13              
14             extends 'File::KDBX::KDF';
15              
16             our $VERSION = '0.904'; # VERSION
17              
18             # Rounds higher than this are eligible for forking:
19             my $FORK_OPTIMIZATION_THRESHOLD = 100_000;
20              
21             BEGIN {
22 11   33 11   5684 my $use_fork = $ENV{NO_FORK} || !can_fork;
23 11 50       5996 *_USE_FORK = $use_fork ? \&TRUE : \&FALSE;
24             }
25              
26              
27 42 50   42 1 137 sub rounds { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
28 56     56 1 152 sub seed { $_[0]->{+KDF_PARAM_AES_SEED} }
29              
30             sub init {
31 158     158 1 273 my $self = shift;
32 158         449 my %args = @_;
33             return $self->SUPER::init(
34             KDF_PARAM_AES_ROUNDS() => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
35             KDF_PARAM_AES_SEED() => $args{+KDF_PARAM_AES_SEED} // $args{seed},
36 158   66     976 );
      66        
37             }
38              
39             sub _transform {
40 42     42   86 my $self = shift;
41 42         80 my $key = shift;
42              
43 42         142 my $seed = $self->seed;
44 42         145 my $rounds = $self->rounds;
45              
46 42 100       127 length($key) == 32 or throw 'Raw key must be 32 bytes', size => length($key);
47 40 50       102 length($seed) == 32 or throw 'Invalid seed length', size => length($seed);
48              
49 40         196 my ($key_l, $key_r) = unpack('(a16)2', $key);
50              
51 40         109 goto NO_FORK if !_USE_FORK || $rounds < $FORK_OPTIMIZATION_THRESHOLD;
52             {
53 0   0     0 my $pid = open(my $read, '-|') // do { alert "fork failed: $!"; goto NO_FORK };
  0         0  
  0         0  
  0         0  
54 0 0       0 if ($pid == 0) { # child
55 0         0 my $l = _transform_half($seed, $key_l, $rounds);
56 0         0 require POSIX;
57 0 0       0 print $l or POSIX::_exit(1);
58 0         0 POSIX::_exit(0);
59             }
60 0         0 my $r = _transform_half($seed, $key_r, $rounds);
61 0 0       0 read($read, my $l, length($key_l)) == length($key_l) or do { alert "read failed: $!", goto NO_FORK };
  0         0  
62 0 0       0 close($read) or do { alert "worker thread exited abnormally", status => $?; goto NO_FORK };
  0         0  
  0         0  
63 0         0 return digest_data('SHA256', $l, $r);
64             }
65              
66             # FIXME: This used to work but now it crashes frequently. Threads are now discouraged anyway, but it might
67             # be nice if this was available for no-fork platforms.
68             # if ($ENV{THREADS} && eval 'use threads; 1') {
69             # my $l = threads->create(\&_transform_half, $key_l, $seed, $rounds);
70             # my $r = _transform_half($key_r, $seed, $rounds);
71             # return digest_data('SHA256', $l->join, $r);
72             # }
73              
74             NO_FORK:
75 40         89807 my $l = _transform_half($seed, $key_l, $rounds);
76 40         89381 my $r = _transform_half($seed, $key_r, $rounds);
77 40         379 return digest_data('SHA256', $l, $r);
78             }
79              
80             sub _transform_half_pp {
81 2     2   3 my $seed = shift;
82 2         3 my $key = shift;
83 2         3 my $rounds = shift;
84              
85 2         40 my $c = Crypt::Cipher->new('AES', $seed);
86              
87 2         4 my $result = $key;
88 2         5 for (my $i = 0; $i < $rounds; ++$i) {
89 20         55 $result = $c->encrypt($result);
90             }
91              
92 2         6 return $result;
93             }
94              
95             BEGIN {
96 11     11   75 my $use_xs = load_xs;
97 11 100       315 *_transform_half = $use_xs ? \&File::KDBX::XS::kdf_aes_transform_half : \&_transform_half_pp;
98             }
99              
100             1;
101              
102             __END__