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(:kdf);
  10 use File::KDBX::Error;
  11 use File::KDBX::Util qw(:load can_fork);
  12 use namespace::clean;
  13
  14 use parent 'File::KDBX::KDF';
  15
  16 our $VERSION = '999.999'; # VERSION
  17
  18 # Rounds higher than this are eligible for forking:
  19 my $FORK_OPTIMIZATION_THRESHOLD = 100_000;
  20
  21 BEGIN {
  22     load_xs;
  23
  24     my $use_fork = 1;
  25     $use_fork = 0 if $ENV{NO_FORK} || !can_fork;
  26     *USE_FORK = $use_fork ? sub() { 1 } : sub() { 0 };
  27 }
  28
  29 sub init {
  30     my $self = shift;
  31     my %args = @_;
  32     return $self->SUPER::init(
  33         KDF_PARAM_AES_ROUNDS()  => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
  34         KDF_PARAM_AES_SEED()    => $args{+KDF_PARAM_AES_SEED}   // $args{seed},
  35     );
  36 }
  37
  38 =attr rounds
  39
  40     $rounds = $kdf->rounds;
  41
  42 Get the number of times to run the function during transformation.
  43
  44 =cut
  45
  46 sub rounds  { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
  47 sub seed    { $_[0]->{+KDF_PARAM_AES_SEED} }
  48
  49 sub _transform {
  50     my $self    = shift;
  51     my $key     = shift;
  52
  53     my $seed = $self->seed;
  54     my $rounds = $self->rounds;
  55
  56     length($key) == 32 or throw 'Raw key must be 32 bytes', size => length($key);
  57     length($seed) == 32 or throw 'Invalid seed length', size => length($seed);
  58
  59     my ($key_l, $key_r) = unpack('(a16)2', $key);
  60
  61     goto NO_FORK if !USE_FORK || $rounds < $FORK_OPTIMIZATION_THRESHOLD;
  62     {
  63         my $pid = open(my $read, '-|') // do { alert "fork failed: $!"; goto NO_FORK };
  64         if ($pid == 0) { # child
  65             my $l = _transform_half($seed, $key_l, $rounds);
  66             require POSIX;
  67             print $l or POSIX::_exit(1);
  68             POSIX::_exit(0);
  69         }
  70         my $r = _transform_half($seed, $key_r, $rounds);
  71         read($read, my $l, length($key_l)) == length($key_l) or do { alert "read failed: $!", goto NO_FORK };
  72         close($read) or do { alert "worker thread exited abnormally", status => $?; goto NO_FORK };
  73         return digest_data('SHA256', $l, $r);
  74     }
  75
  76     # FIXME: This used to work but now it crashes frequently. threads are discouraged anyway
  77     # if ($ENV{THREADS} && eval 'use threads; 1') {
  78     #     my $l = threads->create(\&_transform_half, $key_l, $seed, $rounds);
  79     #     my $r = _transform_half($key_r, $seed, $rounds);
  80     #     return digest_data('SHA256', $l->join, $r);
  81     # }
  82
  83     NO_FORK:
  84     my $l = _transform_half($seed, $key_l, $rounds);
  85     my $r = _transform_half($seed, $key_r, $rounds);
  86     return digest_data('SHA256', $l, $r);
  87 }
  88
  89 sub _transform_half {
  90     my $xs = __PACKAGE__->can('_transform_half_xs');
  91     goto $xs if $xs;
  92
  93     my $seed    = shift;
  94     my $key     = shift;
  95     my $rounds  = shift;
  96
  97     my $c = Crypt::Cipher->new('AES', $seed);
  98
  99     my $result = $key;
 100     for (my $i = 0; $i < $rounds; ++$i) {
 101         $result = $c->encrypt($result);
 102     }
 103
 104     return $result;
 105 }
 106
 107 1;
 108 __END__
 109
 110 =head1 DESCRIPTION
 111
 112 An AES-256-based key derivation function. This is a L<File::KDBX::KDF> subclass.
 113
 114 This KDF has a long, solid track record. It is supported in both KDBX3 and KDBX4.
 115
 116 =head1 CAVEATS
 117
 118 This module can be pretty slow when the number of rounds is high. If you have L<File::KDBX::XS>, that will
 119 help. If your perl has C<fork>, that will also help. If you need to turn off one or both of these
 120 optimizations for some reason, set the C<PERL_ONLY> (to prevent Loading C<File::KDBX::XS>) and C<NO_FORK>
 121 environment variables.
 122
 123 =cut