File Coverage

blib/lib/File/KDBX/Loader/V3.pm
Criterion Covered Total %
statement 79 83 95.1
branch 38 52 73.0
condition 0 3 0.0
subroutine 12 12 100.0
pod n/a
total 129 150 86.0


line stmt bran cond sub pod time code
1             package File::KDBX::Loader::V3;
2             # ABSTRACT: Load KDBX3 files
3              
4             # magic
5             # headers
6             # body
7             # CRYPT(
8             # start bytes
9             # HASH(
10             # COMPRESS(
11             # xml
12             # )
13             # )
14             # )
15              
16 5     5   2357 use warnings;
  5         9  
  5         154  
17 5     5   25 use strict;
  5         6  
  5         108  
18              
19 5     5   22 use Crypt::Digest qw(digest_data);
  5         8  
  5         206  
20 5     5   24 use Encode qw(decode);
  5         7  
  5         220  
21 5     5   43 use File::KDBX::Constants qw(:header :compression :kdf);
  5         7  
  5         1129  
22 5     5   33 use File::KDBX::Error;
  5         7  
  5         225  
23 5     5   769 use File::KDBX::IO::Crypt;
  5         7  
  5         175  
24 5     5   761 use File::KDBX::IO::HashBlock;
  5         10  
  5         180  
25 5     5   27 use File::KDBX::Util qw(:class :int :io :load erase_scoped);
  5         8  
  5         717  
26 5     5   38 use namespace::clean;
  5         12  
  5         25  
27              
28             extends 'File::KDBX::Loader';
29              
30             our $VERSION = '0.904'; # VERSION
31              
32             sub _read_header {
33 160     160   199 my $self = shift;
34 160         172 my $fh = shift;
35              
36 160 50       250 read_all $fh, my $buf, 3 or throw 'Malformed header field, expected header type and size';
37 160         336 my ($type, $size) = unpack('C S<', $buf);
38              
39 160         192 my $val;
40 160 50       239 if (0 < $size) {
41 160 50       250 read_all $fh, $val, $size or throw 'Expected header value', type => $type, size => $size;
42 160         215 $buf .= $val;
43             }
44              
45 160         273 $type = to_header_constant($type);
46 160 100 0     592 if ($type == HEADER_END) {
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    0          
47             # done
48             }
49             elsif ($type == HEADER_COMMENT) {
50 0         0 $val = decode('UTF-8', $val);
51             }
52             elsif ($type == HEADER_CIPHER_ID) {
53 16 50       38 $size == 16 or throw 'Invalid cipher UUID length', got => $size, expected => $size;
54             }
55             elsif ($type == HEADER_COMPRESSION_FLAGS) {
56 16         38 $val = unpack('L<', $val);
57             }
58             elsif ($type == HEADER_MASTER_SEED) {
59 16 50       44 $size == 32 or throw 'Invalid master seed length', got => $size, expected => $size;
60             }
61             elsif ($type == HEADER_TRANSFORM_SEED) {
62             # nothing
63             }
64             elsif ($type == HEADER_TRANSFORM_ROUNDS) {
65 16         56 ($val) = unpack_Ql($val);
66             }
67             elsif ($type == HEADER_ENCRYPTION_IV) {
68             # nothing
69             }
70             elsif ($type == HEADER_INNER_RANDOM_STREAM_KEY) {
71             # nothing
72             }
73             elsif ($type == HEADER_STREAM_START_BYTES) {
74             # nothing
75             }
76             elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) {
77 16         39 ($val) = unpack('L<', $val);
78             }
79             elsif ($type == HEADER_KDF_PARAMETERS ||
80             $type == HEADER_PUBLIC_CUSTOM_DATA) {
81 0         0 throw "Unexpected KDBX4 header: $type", type => $type;
82             }
83             else {
84 0         0 alert "Unknown header: $type", type => $type;
85             }
86              
87 160 50       546 return wantarray ? ($type => $val, $buf) : $buf;
88             }
89              
90             sub _read_body {
91 16     16   32 my $self = shift;
92 16         22 my $fh = shift;
93 16         32 my $key = shift;
94 16         21 my $header_data = shift;
95 16         38 my $kdbx = $self->kdbx;
96              
97             # assert all required headers present
98 16         48 for my $field (
99             HEADER_CIPHER_ID,
100             HEADER_ENCRYPTION_IV,
101             HEADER_MASTER_SEED,
102             HEADER_INNER_RANDOM_STREAM_KEY,
103             HEADER_STREAM_START_BYTES,
104             ) {
105 80 50       137 defined $kdbx->headers->{$field} or throw "Missing $field";
106             }
107              
108             $kdbx->kdf_parameters({
109             KDF_PARAM_UUID() => KDF_UUID_AES,
110             KDF_PARAM_AES_ROUNDS() => delete $kdbx->headers->{+HEADER_TRANSFORM_ROUNDS},
111 16         46 KDF_PARAM_AES_SEED() => delete $kdbx->headers->{+HEADER_TRANSFORM_SEED},
112             });
113              
114 16         44 my $master_seed = $kdbx->headers->{+HEADER_MASTER_SEED};
115              
116 16         27 my @cleanup;
117 16         54 $key = $kdbx->composite_key($key);
118              
119 16         54 my $response = $key->challenge($master_seed);
120 16         53 push @cleanup, erase_scoped $response;
121              
122 16         225 my $transformed_key = $kdbx->kdf->transform($key);
123 16         77 push @cleanup, erase_scoped $transformed_key;
124              
125 16         223 my $final_key = digest_data('SHA256', $master_seed, $response, $transformed_key);
126 16         70 push @cleanup, erase_scoped $final_key;
127              
128 16         187 my $cipher = $kdbx->cipher(key => $final_key);
129 16         110 $fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher);
130              
131 16 50       50 read_all $fh, my $start_bytes, 32 or throw 'Failed to read starting bytes';
132              
133 16         54 my $expected_start_bytes = $kdbx->headers->{stream_start_bytes};
134 16 100       60 $start_bytes eq $expected_start_bytes
135             or throw "Invalid credentials or data is corrupt (wrong starting bytes)\n",
136             got => $start_bytes, expected => $expected_start_bytes, headers => $kdbx->headers;
137              
138 13         62 $kdbx->key($key);
139              
140 13         80 $fh = File::KDBX::IO::HashBlock->new($fh);
141              
142 13         39 my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
143 13 100       43 if ($compress == COMPRESSION_GZIP) {
    50          
144 12         47 load_optional('IO::Uncompress::Gunzip');
145 12 50       81 $fh = IO::Uncompress::Gunzip->new($fh)
146             or throw "Failed to initialize compression library: $IO::Uncompress::Gunzip::GunzipError",
147             error => $IO::Uncompress::Gunzip::GunzipError;
148             }
149             elsif ($compress != COMPRESSION_NONE) {
150 0         0 throw "Unsupported compression ($compress)\n", compression_flags => $compress;
151             }
152              
153 13         2050 $self->_read_inner_body($fh);
154 13         123 close($fh);
155              
156 13 100       130 if (my $header_hash = $kdbx->meta->{header_hash}) {
157 11         110 my $got_header_hash = digest_data('SHA256', $header_data);
158 11 100       85 $header_hash eq $got_header_hash
159             or throw 'Header hash does not match', got => $got_header_hash, expected => $header_hash;
160             }
161             }
162              
163             1;
164              
165             __END__