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

   1 package File::KDBX::Cipher;
   2 # ABSTRACT: A block cipher mode or cipher stream
   3
   4 use warnings;
   5 use strict;
   6
   7 use Devel::GlobalDestruction;
   8 use File::KDBX::Constants qw(:cipher :random_stream);
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(:class erase format_uuid);
  11 use Module::Load;
  12 use Scalar::Util qw(looks_like_number);
  13 use namespace::clean;
  14
  15 our $VERSION = '999.999'; # VERSION
  16
  17 my %CIPHERS;
  18
  19 =attr uuid
  20
  21     $uuid = $cipher->uuid;
  22
  23 Get the UUID if the cipher was constructed with one.
  24
  25 =attr stream_id
  26
  27     $stream_id = $cipher->stream_id;
  28
  29 Get the stream ID if the cipher was constructed with one.
  30
  31 =attr key
  32
  33     $key = $cipher->key;
  34
  35 Get the raw encryption key.
  36
  37 =attr iv
  38
  39     $iv = $cipher->iv;
  40
  41 Get the initialization vector.
  42
  43 =attr iv_size
  44
  45     $size = $cipher->iv_size;
  46
  47 Get the expected size of the initialization vector, in bytes.
  48
  49 =attr key_size
  50
  51     $size = $cipher->key_size;
  52
  53 Get the size the mode or stream expects the key to be, in bytes.
  54
  55 =attr block_size
  56
  57     $size = $cipher->block_size;
  58
  59 Get the block size, in bytes.
  60
  61 =attr algorithm
  62
  63 Get the symmetric cipher algorithm.
  64
  65 =cut
  66
  67 has 'uuid',         is => 'ro';
  68 has 'stream_id',    is => 'ro';
  69 has 'key',          is => 'ro';
  70 has 'iv',           is => 'ro';
  71 sub iv_size     {  0 }
  72 sub key_size    { -1 }
  73 sub block_size  {  0 }
  74 sub algorithm   { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' }
  75
  76 =method new
  77
  78 =method new_from_uuid
  79
  80 =method new_from_stream_id
  81
  82     $cipher = File::KDBX::Cipher->new(uuid => $uuid, key => $key, iv => $iv);
  83     # OR
  84     $cipher = File::KDBX::Cipher->new_from_uuid($uuid, key => $key, iv => $iv);
  85
  86     $cipher = File::KDBX::Cipher->new(stream_id => $id, key => $key);
  87     # OR
  88     $cipher = File::KDBX::Cipher->new_from_stream_id($id, key => $key);
  89
  90 Construct a new L<File::KDBX::Cipher>.
  91
  92 This is a factory method which returns a subclass.
  93
  94 =cut
  95
  96 sub new {
  97     my $class = shift;
  98     my %args = @_;
  99
 100     return $class->new_from_uuid(delete $args{uuid}, %args) if defined $args{uuid};
 101     return $class->new_from_stream_id(delete $args{stream_id}, %args) if defined $args{stream_id};
 102
 103     throw 'Must pass uuid or stream_id';
 104 }
 105
 106 sub new_from_uuid {
 107     my $class = shift;
 108     my $uuid  = shift;
 109     my %args  = @_;
 110
 111     $args{key} or throw 'Missing encryption key';
 112     $args{iv}  or throw 'Missing encryption IV';
 113
 114     my $formatted_uuid = format_uuid($uuid);
 115
 116     my $cipher = $CIPHERS{$uuid} or throw "Unsupported cipher ($formatted_uuid)", uuid => $uuid;
 117     ($class, my %registration_args) = @$cipher;
 118
 119     my @args = (%args, %registration_args, uuid => $uuid);
 120     load $class;
 121     my $self = bless {@args}, $class;
 122     return $self->init(@args);
 123 }
 124
 125 sub new_from_stream_id {
 126     my $class = shift;
 127     my $id    = shift;
 128     my %args  = @_;
 129
 130     $args{key} or throw 'Missing encryption key';
 131
 132     my $cipher = $CIPHERS{$id} or throw "Unsupported stream cipher ($id)", id => $id;
 133     ($class, my %registration_args) = @$cipher;
 134
 135     my @args = (%args, %registration_args, stream_id => $id);
 136     load $class;
 137     my $self = bless {@args}, $class;
 138     return $self->init(@args);
 139 }
 140
 141 =method init
 142
 143     $self->init;
 144
 145 Initialize the cipher. Called by </new>.
 146
 147 =cut
 148
 149 sub init { $_[0] }
 150
 151 sub DESTROY { !in_global_destruction and erase \$_[0]->{key} }
 152
 153 =method encrypt
 154
 155     $ciphertext = $cipher->encrypt($plaintext, ...);
 156
 157 Encrypt some data.
 158
 159 =cut
 160
 161 sub encrypt { die 'Not implemented' }
 162
 163 =method decrypt
 164
 165     $plaintext = $cipher->decrypt($ciphertext, ...);
 166
 167 Decrypt some data.
 168
 169 =cut
 170
 171 sub decrypt { die 'Not implemented' }
 172
 173 =method finish
 174
 175     $ciphertext .= $cipher->finish; # if encrypting
 176     $plaintext  .= $cipher->finish; # if decrypting
 177
 178 Finish the stream.
 179
 180 =cut
 181
 182 sub finish { '' }
 183
 184 =method encrypt_finish
 185
 186     $ciphertext = $cipher->encrypt_finish($plaintext, ...);
 187
 188 Encrypt and finish a stream in one call.
 189
 190 =cut
 191
 192 sub encrypt_finish {
 193     my $self = shift;
 194     my $out = $self->encrypt(@_);
 195     $out .= $self->finish;
 196     return $out;
 197 }
 198
 199 =method decrypt_finish
 200
 201     $plaintext = $cipher->decrypt_finish($ciphertext, ...);
 202
 203 Decrypt and finish a stream in one call.
 204
 205 =cut
 206
 207 sub decrypt_finish {
 208     my $self = shift;
 209     my $out = $self->decrypt(@_);
 210     $out .= $self->finish;
 211     return $out;
 212 }
 213
 214 =method register
 215
 216     File::KDBX::Cipher->register($uuid => $package, %args);
 217
 218 Register a cipher. Registered ciphers can be used to encrypt and decrypt KDBX databases. A cipher's UUID
 219 B<must> be unique and B<musn't change>. A cipher UUID is written into each KDBX file and the associated cipher
 220 must be registered with the same UUID in order to decrypt the KDBX file.
 221
 222 C<$package> should be a Perl package relative to C<File::KDBX::Cipher::> or prefixed with a C<+> if it is
 223 a fully-qualified package. C<%args> are passed as-is to the cipher's L</init> method.
 224
 225 =cut
 226
 227 sub register {
 228     my $class   = shift;
 229     my $id      = shift;
 230     my $package = shift;
 231     my @args    = @_;
 232
 233     my $formatted_id = looks_like_number($id) ? $id : format_uuid($id);
 234     $package = "${class}::${package}" if $package !~ s/^\+// && $package !~ /^\Q${class}::\E/;
 235
 236     my %blacklist = map { (looks_like_number($_) ? $_ : File::KDBX::Util::uuid($_)) => 1 }
 237         split(/,/, $ENV{FILE_KDBX_CIPHER_BLACKLIST} // '');
 238     if ($blacklist{$id} || $blacklist{$package}) {
 239         alert "Ignoring blacklisted cipher ($formatted_id)", id => $id, package => $package;
 240         return;
 241     }
 242
 243     if (defined $CIPHERS{$id}) {
 244         alert "Overriding already-registered cipher ($formatted_id) with package $package",
 245             id      => $id,
 246             package => $package;
 247     }
 248
 249     $CIPHERS{$id} = [$package, @args];
 250 }
 251
 252 =method unregister
 253
 254     File::KDBX::Cipher->unregister($uuid);
 255
 256 Unregister a cipher. Unregistered ciphers can no longer be used to encrypt and decrypt KDBX databases, until
 257 reregistered (see L</register>).
 258
 259 =cut
 260
 261 sub unregister {
 262     delete $CIPHERS{$_} for @_;
 263 }
 264
 265 BEGIN {
 266     __PACKAGE__->register(CIPHER_UUID_AES128,   'CBC',    algorithm => 'AES',     key_size => 16);
 267     __PACKAGE__->register(CIPHER_UUID_AES256,   'CBC',    algorithm => 'AES',     key_size => 32);
 268     __PACKAGE__->register(CIPHER_UUID_SERPENT,  'CBC',    algorithm => 'Serpent', key_size => 32);
 269     __PACKAGE__->register(CIPHER_UUID_TWOFISH,  'CBC',    algorithm => 'Twofish', key_size => 32);
 270     __PACKAGE__->register(CIPHER_UUID_CHACHA20, 'Stream', algorithm => 'ChaCha');
 271     __PACKAGE__->register(CIPHER_UUID_SALSA20,  'Stream', algorithm => 'Salsa20');
 272     __PACKAGE__->register(STREAM_ID_CHACHA20,   'Stream', algorithm => 'ChaCha');
 273     __PACKAGE__->register(STREAM_ID_SALSA20,    'Stream', algorithm => 'Salsa20');
 274 }
 275
 276 1;
 277 __END__
 278
 279 =head1 SYNOPSIS
 280
 281     use File::KDBX::Cipher;
 282
 283     my $cipher = File::KDBX::Cipher->new(uuid => $uuid, key => $key, iv => $iv);
 284
 285     my $ciphertext = $cipher->encrypt('plaintext');
 286     $ciphertext .= $cipher->encrypt('more plaintext');
 287     $ciphertext .= $cipher->finish;
 288
 289     my $plaintext = $cipher->decrypt('ciphertext');
 290     $plaintext .= $cipher->decrypt('more ciphertext');
 291     $plaintext .= $cipher->finish;
 292
 293 =head1 DESCRIPTION
 294
 295 A cipher is used to encrypt and decrypt KDBX files. The L<File::KDBX> distribution comes with several
 296 pre-registered ciphers ready to go:
 297
 298 =for :list
 299 * C<61AB05A1-9464-41C3-8D74-3A563DF8DD35> - AES128 (legacy)
 300 * C<31C1F2E6-BF71-4350-BE58-05216AFC5AFF> - AES256
 301 * C<D6038A2B-8B6F-4CB5-A524-339A31DBB59A> - ChaCha20
 302 * C<716E1C8A-EE17-4BDC-93AE-A977B882833A> - Salsa20
 303 * C<098563FF-DDF7-4F98-8619-8079F6DB897A> - Serpent
 304 * C<AD68F29F-576F-4BB9-A36A-D47AF965346C> - Twofish
 305
 306 B<NOTE:> If you want your KDBX file to be readable by other KeePass implementations, you must use a UUID and
 307 algorithm that they support. From the list above, AES256 and ChaCha20 are well-supported. You should avoid
 308 AES128 for new databases.
 309
 310 You can also L</register> your own cipher. Here is a skeleton:
 311
 312     package File::KDBX::Cipher::MyCipher;
 313
 314     use parent 'File::KDBX::Cipher';
 315
 316     File::KDBX::Cipher->register(
 317         # $uuid, $package, %args
 318         "\x12\x34\x56\x78\x9a\xbc\xde\xfg\x12\x34\x56\x78\x9a\xbc\xde\xfg" => __PACKAGE__,
 319     );
 320
 321     sub init { ... } # optional
 322
 323     sub encrypt { ... }
 324     sub decrypt { ... }
 325     sub finish  { ... }
 326
 327     sub key_size   { ... }
 328     sub iv_size    { ... }
 329     sub block_size { ... }
 330
 331 =cut