File Coverage

blib/lib/File/KDBX/Cipher.pm
Criterion Covered Total %
statement 82 102 80.3
branch 17 36 47.2
condition 5 16 31.2
subroutine 20 30 66.6
pod 19 19 100.0
total 143 203 70.4


line stmt bran cond sub pod time code
1             package File::KDBX::Cipher;
2             # ABSTRACT: A block cipher mode or cipher stream
3              
4 8     8   93976 use warnings;
  8         13  
  8         223  
5 8     8   34 use strict;
  8         13  
  8         135  
6              
7 8     8   381 use Devel::GlobalDestruction;
  8         486  
  8         41  
8 8     8   453 use File::KDBX::Constants qw(:cipher :random_stream);
  8         16  
  8         1052  
9 8     8   49 use File::KDBX::Error;
  8         12  
  8         353  
10 8     8   60 use File::KDBX::Util qw(:class erase format_uuid);
  8         16  
  8         760  
11 8     8   55 use Module::Load;
  8         13  
  8         45  
12 8     8   403 use Scalar::Util qw(looks_like_number);
  8         15  
  8         310  
13 8     8   48 use namespace::clean;
  8         14  
  8         48  
14              
15             our $VERSION = '0.904'; # VERSION
16              
17 0 0   0 1 0 my %CIPHERS;
18 0 0   0 1 0  
19 0 50 0 238 1 0  
  238         678  
20 0 50 0 238 1 0 has 'uuid', is => 'ro';
  238         1199  
21 238   50     765 has 'stream_id', is => 'ro';
22 238   50     1839 has 'key', is => 'ro';
23             has 'iv', is => 'ro';
24 0     0 1 0 sub iv_size { 0 }
25 0     0 1 0 sub key_size { -1 }
26 0     0 1 0 sub block_size { 0 }
27 238 50   238 1 896 sub algorithm { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' }
28              
29              
30             sub new {
31 142     142 1 8496 my $class = shift;
32 142         447 my %args = @_;
33              
34 142 100       459 return $class->new_from_uuid(delete $args{uuid}, %args) if defined $args{uuid};
35 101 50       539 return $class->new_from_stream_id(delete $args{stream_id}, %args) if defined $args{stream_id};
36              
37 0         0 throw 'Must pass uuid or stream_id';
38             }
39              
40             sub new_from_uuid {
41 41     41 1 97 my $class = shift;
42 41         63 my $uuid = shift;
43 41         107 my %args = @_;
44              
45 41 50       106 $args{key} or throw 'Missing encryption key';
46 41 50       95 $args{iv} or throw 'Missing encryption IV';
47              
48 41         111 my $formatted_uuid = format_uuid($uuid);
49              
50 41 50       137 my $cipher = $CIPHERS{$uuid} or throw "Unsupported cipher ($formatted_uuid)", uuid => $uuid;
51 41         150 ($class, my %registration_args) = @$cipher;
52              
53 41         144 my @args = (%args, %registration_args, uuid => $uuid);
54 41         148 load $class;
55 41         2421 my $self = bless {@args}, $class;
56 41         165 return $self->init(@args);
57             }
58              
59             sub new_from_stream_id {
60 101     101 1 167 my $class = shift;
61 101         152 my $id = shift;
62 101         205 my %args = @_;
63              
64 101 50       305 $args{key} or throw 'Missing encryption key';
65              
66 101 50       291 my $cipher = $CIPHERS{$id} or throw "Unsupported stream cipher ($id)", id => $id;
67 101         309 ($class, my %registration_args) = @$cipher;
68              
69 101         364 my @args = (%args, %registration_args, stream_id => $id);
70 101         388 load $class;
71 101         5397 my $self = bless {@args}, $class;
72 101         388 return $self->init(@args);
73             }
74              
75              
76 10     10 1 52 sub init { $_[0] }
77              
78 233 50   233   5098 sub DESTROY { !in_global_destruction and erase \$_[0]->{key} }
79              
80              
81 0     0 1 0 sub encrypt { die 'Not implemented' }
82              
83              
84 0     0 1 0 sub decrypt { die 'Not implemented' }
85              
86              
87 0     0 1 0 sub finish { '' }
88              
89              
90             sub encrypt_finish {
91 2     2 1 1468 my $self = shift;
92 2         5 my $out = $self->encrypt(@_);
93 2         6 $out .= $self->finish;
94 2         5 return $out;
95             }
96              
97              
98             sub decrypt_finish {
99 0     0 1 0 my $self = shift;
100 0         0 my $out = $self->decrypt(@_);
101 0         0 $out .= $self->finish;
102 0         0 return $out;
103             }
104              
105              
106             sub register {
107 64     64 1 84 my $class = shift;
108 64         99 my $id = shift;
109 64         69 my $package = shift;
110 64         123 my @args = @_;
111              
112 64 100       201 my $formatted_id = looks_like_number($id) ? $id : format_uuid($id);
113 64 50 33     419 $package = "${class}::${package}" if $package !~ s/^\+// && $package !~ /^\Q${class}::\E/;
114              
115 0 0       0 my %blacklist = map { (looks_like_number($_) ? $_ : File::KDBX::Util::uuid($_)) => 1 }
116 64   50     245 split(/,/, $ENV{FILE_KDBX_CIPHER_BLACKLIST} // '');
117 64 50 33     198 if ($blacklist{$id} || $blacklist{$package}) {
118 0         0 alert "Ignoring blacklisted cipher ($formatted_id)", id => $id, package => $package;
119 0         0 return;
120             }
121              
122 64 50       117 if (defined $CIPHERS{$id}) {
123 0         0 alert "Overriding already-registered cipher ($formatted_id) with package $package",
124             id => $id,
125             package => $package;
126             }
127              
128 64         450 $CIPHERS{$id} = [$package, @args];
129             }
130              
131              
132             sub unregister {
133 0     0 1   delete $CIPHERS{$_} for @_;
134             }
135              
136             BEGIN {
137 8     8   10677 __PACKAGE__->register(CIPHER_UUID_AES128, 'CBC', algorithm => 'AES', key_size => 16);
138 8         31 __PACKAGE__->register(CIPHER_UUID_AES256, 'CBC', algorithm => 'AES', key_size => 32);
139 8         26 __PACKAGE__->register(CIPHER_UUID_SERPENT, 'CBC', algorithm => 'Serpent', key_size => 32);
140 8         29 __PACKAGE__->register(CIPHER_UUID_TWOFISH, 'CBC', algorithm => 'Twofish', key_size => 32);
141 8         28 __PACKAGE__->register(CIPHER_UUID_CHACHA20, 'Stream', algorithm => 'ChaCha');
142 8         22 __PACKAGE__->register(CIPHER_UUID_SALSA20, 'Stream', algorithm => 'Salsa20');
143 8         25 __PACKAGE__->register(STREAM_ID_CHACHA20, 'Stream', algorithm => 'ChaCha');
144 8         22 __PACKAGE__->register(STREAM_ID_SALSA20, 'Stream', algorithm => 'Salsa20');
145             }
146              
147             1;
148              
149             __END__