1 package File
::KDBX
::Loader
::V4
;
2 # ABSTRACT: Load KDBX4 files
20 use Crypt
::Digest
qw(digest_data);
21 use Crypt
::Mac
::HMAC
qw(hmac);
22 use Encode
qw(decode);
23 use File
::KDBX
::Constants
qw(:header :inner_header :variant_map :compression);
24 use File
::KDBX
::Error
;
25 use File
::KDBX
::Util
qw(:class :int :io :load erase_scoped);
26 use File
::KDBX
::IO
::Crypt
;
27 use File
::KDBX
::IO
::HmacBlock
;
31 extends
'File::KDBX::Loader';
33 our $VERSION = '999.999'; # VERSION
39 read_all
$fh, my $buf, 5 or throw
'Malformed header field, expected header type and size';
40 my ($type, $size) = unpack('C L<', $buf);
44 read_all
$fh, $val, $size or throw
'Expected header value', type
=> $type, size
=> $size;
48 $type = to_header_constant
($type);
49 if ($type == HEADER_END
) {
52 elsif ($type == HEADER_COMMENT
) {
53 $val = decode
('UTF-8', $val);
55 elsif ($type == HEADER_CIPHER_ID
) {
56 $size == 16 or throw
'Invalid cipher UUID length', got
=> $size, expected
=> $size;
58 elsif ($type == HEADER_COMPRESSION_FLAGS
) {
59 $val = unpack('L<', $val);
61 elsif ($type == HEADER_MASTER_SEED
) {
62 $size == 32 or throw
'Invalid master seed length', got
=> $size, expected
=> $size;
64 elsif ($type == HEADER_ENCRYPTION_IV
) {
67 elsif ($type == HEADER_KDF_PARAMETERS
) {
68 open(my $dict_fh, '<', \
$val);
69 $val = $self->_read_variant_dictionary($dict_fh);
71 elsif ($type == HEADER_PUBLIC_CUSTOM_DATA
) {
72 open(my $dict_fh, '<', \
$val);
73 $val = $self->_read_variant_dictionary($dict_fh);
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 throw
"Unexpected KDBX3 header: $type", type
=> $type;
83 alert
"Unknown header: $type", type
=> $type;
86 return wantarray ? ($type => $val, $buf) : $buf;
89 sub _read_variant_dictionary
{
93 read_all
$fh, my $buf, 2 or throw
'Failed to read variant dictionary version';
94 my ($version) = unpack('S<', $buf);
95 VMAP_VERSION
== ($version & VMAP_VERSION_MAJOR_MASK
)
96 or throw
'Unsupported variant dictionary version', version
=> $version;
101 read_all
$fh, $buf, 1 or throw
'Failed to read variant type';
102 my ($type) = unpack('C', $buf);
103 last if $type == VMAP_TYPE_END
; # terminating null
105 read_all
$fh, $buf, 4 or throw
'Failed to read variant key size';
106 my ($klen) = unpack('L<', $buf);
108 read_all
$fh, my $key, $klen or throw
'Failed to read variant key';
110 read_all
$fh, $buf, 4 or throw
'Failed to read variant size';
111 my ($vlen) = unpack('L<', $buf);
113 read_all
$fh, my $val, $vlen or throw
'Failed to read variant';
115 if ($type == VMAP_TYPE_UINT32
) {
116 ($val) = unpack('L<', $val);
118 elsif ($type == VMAP_TYPE_UINT64
) {
119 ($val) = unpack_Ql
($val);
121 elsif ($type == VMAP_TYPE_BOOL
) {
122 ($val) = unpack('C', $val);
123 $val = boolean
($val);
125 elsif ($type == VMAP_TYPE_INT32
) {
126 ($val) = unpack('l<', $val);
128 elsif ($type == VMAP_TYPE_INT64
) {
129 ($val) = unpack_ql
($val);
131 elsif ($type == VMAP_TYPE_STRING
) {
132 $val = decode
('UTF-8', $val);
134 elsif ($type == VMAP_TYPE_BYTEARRAY
) {
138 throw
'Unknown variant type', type
=> $type;
150 my $header_data = shift;
151 my $kdbx = $self->kdbx;
153 # assert all required headers present
156 HEADER_ENCRYPTION_IV
,
159 defined $kdbx->headers->{$field} or throw
"Missing $field";
165 read_all
$fh, my $header_hash, 32 or throw
'Failed to read header hash';
166 my $got_header_hash = digest_data
('SHA256', $header_data);
167 $got_header_hash eq $header_hash
168 or throw
'Data is corrupt (header checksum mismatch)',
169 got
=> $got_header_hash, expected
=> $header_hash;
171 $key = $kdbx->composite_key($key);
172 my $transformed_key = $kdbx->kdf->transform($key);
173 push @cleanup, erase_scoped
$transformed_key;
175 # authentication check
176 read_all
$fh, my $header_hmac, 32 or throw
'Failed to read header HMAC';
177 my $hmac_key = digest_data
('SHA512', $kdbx->headers->{master_seed
}, $transformed_key, "\x01");
178 push @cleanup, erase_scoped
$hmac_key;
179 my $got_header_hmac = hmac
('SHA256',
180 digest_data
('SHA512', "\xff\xff\xff\xff\xff\xff\xff\xff", $hmac_key),
183 $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;
189 $fh = File
::KDBX
::IO
::HmacBlock-
>new($fh, key
=> $hmac_key);
191 my $final_key = digest_data
('SHA256', $kdbx->headers->{master_seed
}, $transformed_key);
192 push @cleanup, erase_scoped
$final_key;
194 my $cipher = $kdbx->cipher(key
=> $final_key);
195 $fh = File
::KDBX
::IO
::Crypt-
>new($fh, cipher
=> $cipher);
197 my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS
};
198 if ($compress == COMPRESSION_GZIP
) {
199 load_optional
('IO::Uncompress::Gunzip');
200 $fh = IO
::Uncompress
::Gunzip-
>new($fh)
201 or throw
"Failed to initialize compression library: $IO::Uncompress::Gunzip::GunzipError",
202 error
=> $IO::Uncompress
::Gunzip
::GunzipError
;
204 elsif ($compress != COMPRESSION_NONE
) {
205 throw
"Unsupported compression ($compress)\n", compression_flags
=> $compress;
208 $self->_read_inner_headers($fh);
209 $self->_read_inner_body($fh);
212 sub _read_inner_headers
{
216 while (my ($type, $val) = $self->_read_inner_header($fh)) {
217 last if $type == INNER_HEADER_END
;
221 sub _read_inner_header
{
224 my $kdbx = $self->kdbx;
226 read_all
$fh, my $buf, 5 or throw
'Expected inner header type and size';
227 my ($type, $size) = unpack('C L<', $buf);
231 read_all
$fh, $val, $size or throw
'Expected inner header value', type
=> $type, size
=> $size;
234 $type = to_inner_header_constant
($type) // $type;
235 if ($type == INNER_HEADER_END
) {
238 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_ID
) {
239 $val = unpack('L<', $val);
240 $kdbx->inner_headers->{$type} = $val;
242 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_KEY
) {
243 $kdbx->inner_headers->{$type} = $val;
245 elsif ($type == INNER_HEADER_BINARY
) {
246 my $msize = $size - 1;
247 my ($flags, $data) = unpack("C a$msize", $val);
248 my $id = scalar keys %{$kdbx->binaries};
249 $kdbx->binaries->{$id} = {
251 $flags & INNER_HEADER_BINARY_FLAG_PROTECT
? (protect
=> true
) : (),
255 alert
"Ignoring unknown inner header type ($type)", type
=> $type, size
=> $size, value
=> $val;
256 return wantarray ? ($type => $val) : $type;
259 return wantarray ? ($type => $val) : $type;