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   97274 use warnings;
  8         13  
  8         231  
5 8     8   36 use strict;
  8         15  
  8         131  
6              
7 8     8   378 use Devel::GlobalDestruction;
  8         481  
  8         38  
8 8     8   441 use File::KDBX::Constants qw(:cipher :random_stream);
  8         10  
  8         1023  
9 8     8   45 use File::KDBX::Error;
  8         15  
  8         400  
10 8     8   64 use File::KDBX::Util qw(:class erase format_uuid);
  8         12  
  8         806  
11 8     8   57 use Module::Load;
  8         13  
  8         54  
12 8     8   394 use Scalar::Util qw(looks_like_number);
  8         22  
  8         315  
13 8     8   45 use namespace::clean;
  8         13  
  8         53  
14              
15             our $VERSION = '0.905'; # VERSION
16              
17 0 0   0 1 0 my %CIPHERS;
18 0 0   0 1 0  
19 0 50 0 238 1 0  
  238         808  
20 0 50 0 238 1 0 has 'uuid', is => 'ro';
  238         591  
21 238   50     792 has 'stream_id', is => 'ro';
22 238   50     1530 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 944 sub algorithm { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' }
28              
29              
30             sub new {
31 142     142 1 8442 my $class = shift;
32 142         392 my %args = @_;
33              
34 142 100       440 return $class->new_from_uuid(delete $args{uuid}, %args) if defined $args{uuid};
35 101 50       483 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 68 my $class = shift;
42 41         57 my $uuid = shift;
43 41         88 my %args = @_;
44              
45 41 50       89 $args{key} or throw 'Missing encryption key';
46 41 50       83 $args{iv} or throw 'Missing encryption IV';
47              
48 41         99 my $formatted_uuid = format_uuid($uuid);
49              
50 41 50       169 my $cipher = $CIPHERS{$uuid} or throw "Unsupported cipher ($formatted_uuid)", uuid => $uuid;
51 41         124 ($class, my %registration_args) = @$cipher;
52              
53 41         158 my @args = (%args, %registration_args, uuid => $uuid);
54 41         148 load $class;
55 41         2237 my $self = bless {@args}, $class;
56 41         139 return $self->init(@args);
57             }
58              
59             sub new_from_stream_id {
60 101     101 1 151 my $class = shift;
61 101         143 my $id = shift;
62 101         187 my %args = @_;
63              
64 101 50       207 $args{key} or throw 'Missing encryption key';
65              
66 101 50       279 my $cipher = $CIPHERS{$id} or throw "Unsupported stream cipher ($id)", id => $id;
67 101         261 ($class, my %registration_args) = @$cipher;
68              
69 101         292 my @args = (%args, %registration_args, stream_id => $id);
70 101         428 load $class;
71 101         5515 my $self = bless {@args}, $class;
72 101         331 return $self->init(@args);
73             }
74              
75              
76 10     10 1 53 sub init { $_[0] }
77              
78 233 50   233   4794 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 1803 my $self = shift;
92 2         6 my $out = $self->encrypt(@_);
93 2         7 $out .= $self->finish;
94 2         4 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 91 my $class = shift;
108 64         72 my $id = shift;
109 64         68 my $package = shift;
110 64         116 my @args = @_;
111              
112 64 100       217 my $formatted_id = looks_like_number($id) ? $id : format_uuid($id);
113 64 50 33     417 $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     207 split(/,/, $ENV{FILE_KDBX_CIPHER_BLACKLIST} // '');
117 64 50 33     207 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       129 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         460 $CIPHERS{$id} = [$package, @args];
129             }
130              
131              
132             sub unregister {
133 0     0 1   delete $CIPHERS{$_} for @_;
134             }
135              
136             BEGIN {
137 8     8   10400 __PACKAGE__->register(CIPHER_UUID_AES128, 'CBC', algorithm => 'AES', key_size => 16);
138 8         28 __PACKAGE__->register(CIPHER_UUID_AES256, 'CBC', algorithm => 'AES', key_size => 32);
139 8         37 __PACKAGE__->register(CIPHER_UUID_SERPENT, 'CBC', algorithm => 'Serpent', key_size => 32);
140 8         27 __PACKAGE__->register(CIPHER_UUID_TWOFISH, 'CBC', algorithm => 'Twofish', key_size => 32);
141 8         27 __PACKAGE__->register(CIPHER_UUID_CHACHA20, 'Stream', algorithm => 'ChaCha');
142 8         27 __PACKAGE__->register(CIPHER_UUID_SALSA20, 'Stream', algorithm => 'Salsa20');
143 8         20 __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__