File Coverage

blib/lib/File/KDBX/Loader/V4.pm
Criterion Covered Total %
statement 135 144 93.7
branch 64 98 65.3
condition 1 15 6.6
subroutine 18 18 100.0
pod n/a
total 218 275 79.2


line stmt bran cond sub pod time code
1             package File::KDBX::Loader::V4;
2             # ABSTRACT: Load KDBX4 files
3              
4             # magic
5             # headers
6             # headers checksum
7             # headers hmac
8             # body
9             # HMAC(
10             # CRYPT(
11             # COMPRESS(
12             # xml
13             # )
14             # )
15             # )
16              
17 1     1   511 use warnings;
  1         2  
  1         28  
18 1     1   4 use strict;
  1         3  
  1         19  
19              
20 1     1   4 use Crypt::Digest qw(digest_data);
  1         2  
  1         33  
21 1     1   365 use Crypt::Mac::HMAC qw(hmac);
  1         917  
  1         44  
22 1     1   6 use Encode qw(decode);
  1         1  
  1         32  
23 1     1   4 use File::KDBX::Constants qw(:header :inner_header :variant_map :compression);
  1         2  
  1         182  
24 1     1   6 use File::KDBX::Error;
  1         1  
  1         38  
25 1     1   4 use File::KDBX::Util qw(:class :int :io :load erase_scoped);
  1         1  
  1         131  
26 1     1   403 use File::KDBX::IO::Crypt;
  1         3  
  1         37  
27 1     1   415 use File::KDBX::IO::HmacBlock;
  1         2  
  1         36  
28 1     1   5 use boolean;
  1         2  
  1         6  
29 1     1   72 use namespace::clean;
  1         1  
  1         4  
30              
31             extends 'File::KDBX::Loader';
32              
33             our $VERSION = '0.906'; # VERSION
34              
35             sub _read_header {
36 87     87   108 my $self = shift;
37 87         107 my $fh = shift;
38              
39 87 50       182 read_all $fh, my $buf, 5 or throw 'Malformed header field, expected header type and size';
40 87         213 my ($type, $size) = unpack('C L<', $buf);
41              
42 87         99 my $val;
43 87 100       137 if (0 < $size) {
44 74 50       115 read_all $fh, $val, $size or throw 'Expected header value', type => $type, size => $size;
45 74         136 $buf .= $val;
46             }
47              
48 87         157 $type = to_header_constant($type);
49 87 100 0     283 if ($type == HEADER_END) {
    50 0        
    100 0        
    100 0        
    100          
    100          
    100          
    50          
    0          
50             # done
51             }
52             elsif ($type == HEADER_COMMENT) {
53 0         0 $val = decode('UTF-8', $val);
54             }
55             elsif ($type == HEADER_CIPHER_ID) {
56 14 50       27 $size == 16 or throw 'Invalid cipher UUID length', got => $size, expected => $size;
57             }
58             elsif ($type == HEADER_COMPRESSION_FLAGS) {
59 14         34 $val = unpack('L<', $val);
60             }
61             elsif ($type == HEADER_MASTER_SEED) {
62 14 50       26 $size == 32 or throw 'Invalid master seed length', got => $size, expected => $size;
63             }
64             elsif ($type == HEADER_ENCRYPTION_IV) {
65             # nothing
66             }
67             elsif ($type == HEADER_KDF_PARAMETERS) {
68 1     1   6 open(my $dict_fh, '<', \$val);
  1         3  
  1         8  
  14         147  
69 14         726 $val = $self->_read_variant_dictionary($dict_fh);
70             }
71             elsif ($type == HEADER_PUBLIC_CUSTOM_DATA) {
72 3         22 open(my $dict_fh, '<', \$val);
73 3         8 $val = $self->_read_variant_dictionary($dict_fh);
74             }
75             elsif ($type == HEADER_INNER_RANDOM_STREAM_ID ||
76             $type == HEADER_INNER_RANDOM_STREAM_KEY ||
77             $type == HEADER_TRANSFORM_SEED ||
78             $type == HEADER_TRANSFORM_ROUNDS ||
79             $type == HEADER_STREAM_START_BYTES) {
80 0         0 throw "Unexpected KDBX3 header: $type", type => $type;
81             }
82             else {
83 0         0 alert "Unknown header: $type", type => $type;
84             }
85              
86 87 50       319 return wantarray ? ($type => $val, $buf) : $buf;
87             }
88              
89             sub _read_variant_dictionary {
90 17     17   25 my $self = shift;
91 17         26 my $fh = shift;
92              
93 17 50       34 read_all $fh, my $buf, 2 or throw 'Failed to read variant dictionary version';
94 17         44 my ($version) = unpack('S<', $buf);
95 17 50       43 VMAP_VERSION == ($version & VMAP_VERSION_MAJOR_MASK)
96             or throw 'Unsupported variant dictionary version', version => $version;
97              
98 17         24 my %dict;
99              
100 17         21 while (1) {
101 80 50       133 read_all $fh, $buf, 1 or throw 'Failed to read variant type';
102 80         131 my ($type) = unpack('C', $buf);
103 80 100       135 last if $type == VMAP_TYPE_END; # terminating null
104              
105 63 50       100 read_all $fh, $buf, 4 or throw 'Failed to read variant key size';
106 63         103 my ($klen) = unpack('L<', $buf);
107              
108 63 50       114 read_all $fh, my $key, $klen or throw 'Failed to read variant key';
109              
110 63 50       110 read_all $fh, $buf, 4 or throw 'Failed to read variant size';
111 63         109 my ($vlen) = unpack('L<', $buf);
112              
113 63 50       91 read_all $fh, my $val, $vlen or throw 'Failed to read variant';
114              
115 63 100       194 if ($type == VMAP_TYPE_UINT32) {
    100          
    100          
    50          
    50          
    100          
    50          
116 11         16 ($val) = unpack('L<', $val);
117             }
118             elsif ($type == VMAP_TYPE_UINT64) {
119 19         59 ($val) = unpack_Ql($val);
120             }
121             elsif ($type == VMAP_TYPE_BOOL) {
122 1         4 ($val) = unpack('C', $val);
123 1         5 $val = boolean($val);
124             }
125             elsif ($type == VMAP_TYPE_INT32) {
126 0         0 ($val) = unpack('l<', $val);
127             }
128             elsif ($type == VMAP_TYPE_INT64) {
129 0         0 ($val) = unpack_ql($val);
130             }
131             elsif ($type == VMAP_TYPE_STRING) {
132 1         6 $val = decode('UTF-8', $val);
133             }
134             elsif ($type == VMAP_TYPE_BYTEARRAY) {
135             # nothing
136             }
137             else {
138 0         0 throw 'Unknown variant type', type => $type;
139             }
140 63         210 $dict{$key} = $val;
141             }
142              
143 17         83 return \%dict;
144             }
145              
146             sub _read_body {
147 14     14   19 my $self = shift;
148 14         27 my $fh = shift;
149 14         16 my $key = shift;
150 14         23 my $header_data = shift;
151 14         59 my $kdbx = $self->kdbx;
152              
153             # assert all required headers present
154 14         36 for my $field (
155             HEADER_CIPHER_ID,
156             HEADER_ENCRYPTION_IV,
157             HEADER_MASTER_SEED,
158             ) {
159 42 50       82 defined $kdbx->headers->{$field} or throw "Missing $field";
160             }
161              
162 14         23 my @cleanup;
163              
164             # checksum check
165 14 50       28 read_all $fh, my $header_hash, 32 or throw 'Failed to read header hash';
166 14         111 my $got_header_hash = digest_data('SHA256', $header_data);
167 14 50       39 $got_header_hash eq $header_hash
168             or throw 'Data is corrupt (header checksum mismatch)',
169             got => $got_header_hash, expected => $header_hash;
170              
171 14         42 $key = $kdbx->composite_key($key);
172 14         45 my $transformed_key = $kdbx->kdf->transform($key);
173 14         77 push @cleanup, erase_scoped $transformed_key;
174              
175             # authentication check
176 14 50       164 read_all $fh, my $header_hmac, 32 or throw 'Failed to read header HMAC';
177 14         47 my $hmac_key = digest_data('SHA512', $kdbx->headers->{master_seed}, $transformed_key, "\x01");
178 14         35 push @cleanup, erase_scoped $hmac_key;
179 14         296 my $got_header_hmac = hmac('SHA256',
180             digest_data('SHA512', "\xff\xff\xff\xff\xff\xff\xff\xff", $hmac_key),
181             $header_data,
182             );
183 14 100       64 $got_header_hmac eq $header_hmac
184             or throw "Invalid credentials or data is corrupt (header HMAC mismatch)\n",
185             got => $got_header_hmac, expected => $header_hmac;
186              
187 8         38 $kdbx->key($key);
188              
189 8         53 $fh = File::KDBX::IO::HmacBlock->new($fh, key => $hmac_key);
190              
191 8         29 my $final_key = digest_data('SHA256', $kdbx->headers->{master_seed}, $transformed_key);
192 8         33 push @cleanup, erase_scoped $final_key;
193              
194 8         105 my $cipher = $kdbx->cipher(key => $final_key);
195 8         54 $fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher);
196              
197 8         22 my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
198 8 50       32 if ($compress == COMPRESSION_GZIP) {
    0          
199 8         28 load_optional('IO::Uncompress::Gunzip');
200 8 50       53 $fh = IO::Uncompress::Gunzip->new($fh)
201             or throw "Failed to initialize compression library: $IO::Uncompress::Gunzip::GunzipError",
202             error => $IO::Uncompress::Gunzip::GunzipError;
203             }
204             elsif ($compress != COMPRESSION_NONE) {
205 0         0 throw "Unsupported compression ($compress)\n", compression_flags => $compress;
206             }
207              
208 8         870 $self->_read_inner_headers($fh);
209 8         209 $self->_read_inner_body($fh);
210             }
211              
212             sub _read_inner_headers {
213 8     8   13 my $self = shift;
214 8         13 my $fh = shift;
215              
216 8         29 while (my ($type, $val) = $self->_read_inner_header($fh)) {
217 25 100       70 last if $type == INNER_HEADER_END;
218             }
219             }
220              
221             sub _read_inner_header {
222 25     25   32 my $self = shift;
223 25         28 my $fh = shift;
224 25         63 my $kdbx = $self->kdbx;
225              
226 25 50       61 read_all $fh, my $buf, 5 or throw 'Expected inner header type and size';
227 25         67 my ($type, $size) = unpack('C L<', $buf);
228              
229 25         28 my $val;
230 25 100       49 if (0 < $size) {
231 17 50       36 read_all $fh, $val, $size or throw 'Expected inner header value', type => $type, size => $size;
232             }
233              
234 25   33     69 $type = to_inner_header_constant($type) // $type;
235 25 100       95 if ($type == INNER_HEADER_END) {
    100          
    100          
    50          
236             # nothing
237             }
238             elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_ID) {
239 8         19 $val = unpack('L<', $val);
240 8         30 $kdbx->inner_headers->{$type} = $val;
241             }
242             elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_KEY) {
243 8         26 $kdbx->inner_headers->{$type} = $val;
244             }
245             elsif ($type == INNER_HEADER_BINARY) {
246 1         2 my $msize = $size - 1;
247 1         5 my ($flags, $data) = unpack("C a$msize", $val);
248 1         2 my $id = scalar keys %{$kdbx->binaries};
  1         5  
249 1 50       5 $kdbx->binaries->{$id} = {
250             value => $data,
251             $flags & INNER_HEADER_BINARY_FLAG_PROTECT ? (protect => true) : (),
252             };
253             }
254             else {
255 0         0 alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val;
256 0 0       0 return wantarray ? ($type => $val) : $type;
257             }
258              
259 25 50       108 return wantarray ? ($type => $val) : $type;
260             }
261              
262             1;
263              
264             __END__