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