]>
Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/KDF/AES.pm
206bc132698c91b6167a28e874b45238f20077ec
1 package File
::KDBX
::KDF
::AES
;
2 # ABSTRACT: Using the AES cipher as a key derivation function
8 use Crypt
::Digest
qw(digest_data);
9 use File
::KDBX
::Constants
qw(:bool :kdf);
10 use File
::KDBX
::Error
;
11 use File
::KDBX
::Util
qw(:class :load can_fork);
14 extends
'File::KDBX::KDF';
16 our $VERSION = '0.903'; # VERSION
18 # Rounds higher than this are eligible for forking:
19 my $FORK_OPTIMIZATION_THRESHOLD = 100_000;
22 my $use_fork = $ENV{NO_FORK
} || !can_fork
;
23 *_USE_FORK
= $use_fork ? \
&TRUE
: \
&FALSE
;
27 sub rounds
{ $_[0]->{+KDF_PARAM_AES_ROUNDS
} || KDF_DEFAULT_AES_ROUNDS
}
28 sub seed
{ $_[0]->{+KDF_PARAM_AES_SEED
} }
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
},
43 my $seed = $self->seed;
44 my $rounds = $self->rounds;
46 length($key) == 32 or throw
'Raw key must be 32 bytes', size
=> length($key);
47 length($seed) == 32 or throw
'Invalid seed length', size
=> length($seed);
49 my ($key_l, $key_r) = unpack('(a16)2', $key);
51 goto NO_FORK
if !_USE_FORK
|| $rounds < $FORK_OPTIMIZATION_THRESHOLD;
53 my $pid = open(my $read, '-|') // do { alert
"fork failed: $!"; goto NO_FORK
};
54 if ($pid == 0) { # child
55 my $l = _transform_half
($seed, $key_l, $rounds);
57 print $l or POSIX
::_exit
(1);
60 my $r = _transform_half
($seed, $key_r, $rounds);
61 read($read, my $l, length($key_l)) == length($key_l) or do { alert
"read failed: $!", goto NO_FORK
};
62 close($read) or do { alert
"worker thread exited abnormally", status
=> $?; goto NO_FORK
};
63 return digest_data
('SHA256', $l, $r);
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);
75 my $l = _transform_half
($seed, $key_l, $rounds);
76 my $r = _transform_half
($seed, $key_r, $rounds);
77 return digest_data
('SHA256', $l, $r);
80 sub _transform_half_pp
{
85 my $c = Crypt
::Cipher-
>new('AES', $seed);
88 for (my $i = 0; $i < $rounds; ++$i) {
89 $result = $c->encrypt($result);
97 *_transform_half
= $use_xs ? \
&File
::KDBX
::XS
::kdf_aes_transform_half
: \
&_transform_half_pp
;
110 File::KDBX::KDF::AES - Using the AES cipher as a key derivation function
118 An AES-256-based key derivation function. This is a L<File::KDBX::KDF> subclass.
120 This KDF has a long, solid track record. It is supported in both KDBX3 and KDBX4.
126 $rounds = $kdf->rounds;
128 Get the number of times to run the function during transformation.
132 This module can be pretty slow when the number of rounds is high. If you have L<File::KDBX::XS>, that will
133 help. If your perl has C<fork>, that will also help. If you need to turn off one or both of these
134 optimizations for some reason, set the C<PERL_ONLY> (to prevent Loading C<File::KDBX::XS>) and C<NO_FORK>
135 environment variables.
139 Please report any bugs or feature requests on the bugtracker website
140 L<https://github.com/chazmcgarvey/File-KDBX/issues>
142 When submitting a bug or request, please include a test-file or a
143 patch to an existing test-file that illustrates the bug or desired
148 Charles McGarvey <ccm@cpan.org>
150 =head1 COPYRIGHT AND LICENSE
152 This software is copyright (c) 2022 by Charles McGarvey.
154 This is free software; you can redistribute it and/or modify it under
155 the same terms as the Perl 5 programming language system itself.
This page took 0.041519 seconds and 3 git commands to generate.