Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/KDF/AES.pm

   1 package File::KDBX::KDF::AES;
   2 # ABSTRACT: Using the AES cipher as a key derivation function
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Cipher;
   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);
  12 use namespace::clean;
  13
  14 extends 'File::KDBX::KDF';
  15
  16 our $VERSION = '0.905'; # VERSION
  17
  18 # Rounds higher than this are eligible for forking:
  19 my $FORK_OPTIMIZATION_THRESHOLD = 100_000;
  20
  21 BEGIN {
  22     my $use_fork = $ENV{NO_FORK} || !can_fork;
  23     *_USE_FORK = $use_fork ? \&TRUE : \&FALSE;
  24 }
  25
  26
  27 sub rounds  { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
  28 sub seed    { $_[0]->{+KDF_PARAM_AES_SEED} }
  29
  30 sub init {
  31     my $self = shift;
  32     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     );
  37 }
  38
  39 sub _transform {
  40     my $self    = shift;
  41     my $key     = shift;
  42
  43     my $seed = $self->seed;
  44     my $rounds = $self->rounds;
  45
  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);
  48
  49     my ($key_l, $key_r) = unpack('(a16)2', $key);
  50
  51     goto NO_FORK if !_USE_FORK || $rounds < $FORK_OPTIMIZATION_THRESHOLD;
  52     {
  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);
  56             require POSIX;
  57             print $l or POSIX::_exit(1);
  58             POSIX::_exit(0);
  59         }
  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);
  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     my $l = _transform_half($seed, $key_l, $rounds);
  76     my $r = _transform_half($seed, $key_r, $rounds);
  77     return digest_data('SHA256', $l, $r);
  78 }
  79
  80 sub _transform_half_pp {
  81     my $seed    = shift;
  82     my $key     = shift;
  83     my $rounds  = shift;
  84
  85     my $c = Crypt::Cipher->new('AES', $seed);
  86
  87     my $result = $key;
  88     for (my $i = 0; $i < $rounds; ++$i) {
  89         $result = $c->encrypt($result);
  90     }
  91
  92     return $result;
  93 }
  94
  95 BEGIN {
  96     my $use_xs = load_xs;
  97     *_transform_half = $use_xs ? \&File::KDBX::XS::kdf_aes_transform_half : \&_transform_half_pp;
  98 }
  99
 100 1;
 101
 102 __END__
 103
 104 =pod
 105
 106 =encoding UTF-8
 107
 108 =head1 NAME
 109
 110 File::KDBX::KDF::AES - Using the AES cipher as a key derivation function
 111
 112 =head1 VERSION
 113
 114 version 0.905
 115
 116 =head1 DESCRIPTION
 117
 118 An AES-256-based key derivation function. This is a L<File::KDBX::KDF> subclass.
 119
 120 This KDF has a long, solid track record. It is supported in both KDBX3 and KDBX4.
 121
 122 =head1 ATTRIBUTES
 123
 124 =head2 rounds
 125
 126     $rounds = $kdf->rounds;
 127
 128 Get the number of times to run the function during transformation.
 129
 130 =head1 CAVEATS
 131
 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.
 136
 137 =head1 BUGS
 138
 139 Please report any bugs or feature requests on the bugtracker website
 140 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 141
 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
 144 feature.
 145
 146 =head1 AUTHOR
 147
 148 Charles McGarvey <ccm@cpan.org>
 149
 150 =head1 COPYRIGHT AND LICENSE
 151
 152 This software is copyright (c) 2022 by Charles McGarvey.
 153
 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.
 156
 157 =cut