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

   1 package File::KDBX::KDF;
   2 # ABSTRACT: A key derivation function
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::PRNG qw(random_bytes);
   8 use File::KDBX::Constants qw(:version :kdf);
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(format_uuid);
  11 use Module::Load;
  12 use Scalar::Util qw(blessed);
  13 use namespace::clean;
  14
  15 our $VERSION = '999.999'; # VERSION
  16
  17 my %KDFS;
  18
  19 =method new
  20
  21     $kdf = File::KDBX::KDF->new(parameters => \%params);
  22
  23 Construct a new KDF.
  24
  25 =cut
  26
  27 sub new {
  28     my $class = shift;
  29     my %args = @_;
  30
  31     my $uuid = $args{+KDF_PARAM_UUID} //= delete $args{uuid} or throw 'Missing KDF UUID', args => \%args;
  32     my $formatted_uuid = format_uuid($uuid);
  33
  34     my $kdf = $KDFS{$uuid} or throw "Unsupported KDF ($formatted_uuid)", uuid => $uuid;
  35     ($class, my %registration_args) = @$kdf;
  36
  37     load $class;
  38     my $self = bless {KDF_PARAM_UUID() => $uuid}, $class;
  39     return $self->init(%args, %registration_args);
  40 }
  41
  42 sub init {
  43     my $self = shift;
  44     my %args = @_;
  45
  46     @$self{keys %args} = values %args;
  47
  48     return $self;
  49 }
  50
  51 =attr uuid
  52
  53     $uuid => $kdf->uuid;
  54
  55 Get the UUID used to determine which function to use.
  56
  57 =cut
  58
  59 sub uuid { $_[0]->{+KDF_PARAM_UUID} }
  60
  61 =attr seed
  62
  63     $seed = $kdf->seed;
  64
  65 Get the seed (or salt, depending on the function).
  66
  67 =cut
  68
  69 sub seed { die "Not implemented" }
  70
  71 =method transform
  72
  73     $transformed_key = $kdf->transform($key);
  74     $transformed_key = $kdf->transform($key, $challenge);
  75
  76 Transform a key. The input key can be either a L<File::KDBX::Key> or a raw binary key, and the
  77 transformed key will be a raw key.
  78
  79 This can take awhile, depending on the KDF parameters.
  80
  81 If a challenge is provided (and the KDF is AES except for the KeePassXC variant), it will be passed to the key
  82 so challenge-response keys can produce raw keys. See L<File::KDBX::Key/raw_key>.
  83
  84 =cut
  85
  86 sub transform {
  87     my $self = shift;
  88     my $key  = shift;
  89
  90     if (blessed $key && $key->can('raw_key')) {
  91         return $self->_transform($key->raw_key) if $self->uuid eq KDF_UUID_AES;
  92         return $self->_transform($key->raw_key($self->seed, @_));
  93     }
  94
  95     return $self->_transform($key);
  96 }
  97
  98 sub _transform { die "Not implemented" }
  99
 100 =method randomize_seed
 101
 102     $kdf->randomize_seed;
 103
 104 Generate a new random seed/salt.
 105
 106 =cut
 107
 108 sub randomize_seed {
 109     my $self = shift;
 110     $self->{+KDF_PARAM_AES_SEED} = random_bytes(length($self->seed));
 111 }
 112
 113 =method register
 114
 115     File::KDBX::KDF->register($uuid => $package, %args);
 116
 117 Register a KDF. Registered KDFs can be used to encrypt and decrypt KDBX databases. A KDF's UUID B<must> be
 118 unique and B<musn't change>. A KDF UUID is written into each KDBX file and the associated KDF must be
 119 registered with the same UUID in order to decrypt the KDBX file.
 120
 121 C<$package> should be a Perl package relative to C<File::KDBX::KDF::> or prefixed with a C<+> if it is
 122 a fully-qualified package. C<%args> are passed as-is to the KDF's L</init> method.
 123
 124 =cut
 125
 126 sub register {
 127     my $class   = shift;
 128     my $id      = shift;
 129     my $package = shift;
 130     my @args    = @_;
 131
 132     my $formatted_id = format_uuid($id);
 133     $package = "${class}::${package}" if $package !~ s/^\+// && $package !~ /^\Q${class}::\E/;
 134
 135     my %blacklist = map { File::KDBX::Util::uuid($_) => 1 } split(/,/, $ENV{FILE_KDBX_KDF_BLACKLIST} // '');
 136     if ($blacklist{$id} || $blacklist{$package}) {
 137         alert "Ignoring blacklisted KDF ($formatted_id)", id => $id, package => $package;
 138         return;
 139     }
 140
 141     if (defined $KDFS{$id}) {
 142         alert "Overriding already-registered KDF ($formatted_id) with package $package",
 143             id      => $id,
 144             package => $package;
 145     }
 146
 147     $KDFS{$id} = [$package, @args];
 148 }
 149
 150 =method unregister
 151
 152     File::KDBX::KDF->unregister($uuid);
 153
 154 Unregister a KDF. Unregistered KDFs can no longer be used to encrypt and decrypt KDBX databases, until
 155 reregistered (see L</register>).
 156
 157 =cut
 158
 159 sub unregister {
 160     delete $KDFS{$_} for @_;
 161 }
 162
 163 BEGIN {
 164     __PACKAGE__->register(KDF_UUID_AES,                     'AES');
 165     __PACKAGE__->register(KDF_UUID_AES_CHALLENGE_RESPONSE,  'AES');
 166     __PACKAGE__->register(KDF_UUID_ARGON2D,                 'Argon2');
 167     __PACKAGE__->register(KDF_UUID_ARGON2ID,                'Argon2');
 168 }
 169
 170 1;
 171 __END__
 172
 173 =head1 DESCRIPTION
 174
 175 A KDF (key derivation function) is used in the transformation of a master key (i.e. one or more component
 176 keys) to produce the final encryption key protecting a KDBX database. The L<File::KDBX> distribution comes
 177 with several pre-registered KDFs ready to go:
 178
 179 =for :list
 180 * C<C9D9F39A-628A-4460-BF74-0D08C18A4FEA> - AES
 181 * C<7C02BB82-79A7-4AC0-927D-114A00648238> - AES (challenge-response variant)
 182 * C<EF636DDF-8C29-444B-91F7-A9A403E30A0C> - Argon2d
 183 * C<9E298B19-56DB-4773-B23D-FC3EC6F0A1E6> - Argon2id
 184
 185 B<NOTE:> If you want your KDBX file to be readable by other KeePass implementations, you must use a UUID and
 186 algorithm that they support. From the list above, all are well-supported except the AES challenge-response
 187 variant which is kind of a pseudo KDF and isn't usually written into files. All of these are good. AES has
 188 a longer track record, but Argon2 has better ASIC resistance.
 189
 190 You can also L</register> your own KDF. Here is a skeleton:
 191
 192     package File::KDBX::KDF::MyKDF;
 193
 194     use parent 'File::KDBX::KDF';
 195
 196     File::KDBX::KDF->register(
 197         # $uuid, $package, %args
 198         "\x12\x34\x56\x78\x9a\xbc\xde\xfg\x12\x34\x56\x78\x9a\xbc\xde\xfg" => __PACKAGE__,
 199     );
 200
 201     sub init { ... } # optional
 202
 203     sub _transform { my ($key) = @_; ... }
 204
 205 =cut