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(:io assert_64bit erase_scoped);
26 use PerlIO
::via
::File
::KDBX
::Crypt
;
27 use PerlIO
::via
::File
::KDBX
::HmacBlock
;
31 use parent
'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 = KDBX_HEADER
($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
) {
120 ($val) = unpack('Q<', $val);
122 elsif ($type == VMAP_TYPE_BOOL
) {
123 ($val) = unpack('C', $val);
124 $val = boolean
($val);
126 elsif ($type == VMAP_TYPE_INT32
) {
127 ($val) = unpack('l<', $val);
129 elsif ($type == VMAP_TYPE_INT64
) {
131 ($val) = unpack('q<', $val);
133 elsif ($type == VMAP_TYPE_STRING
) {
134 $val = decode
('UTF-8', $val);
136 elsif ($type == VMAP_TYPE_BYTEARRAY
) {
140 throw
'Unknown variant type', type
=> $type;
152 my $header_data = shift;
153 my $kdbx = $self->kdbx;
155 # assert all required headers present
158 HEADER_ENCRYPTION_IV
,
161 defined $kdbx->headers->{$field} or throw
"Missing $field";
167 read_all
$fh, my $header_hash, 32 or throw
'Failed to read header hash';
168 my $got_header_hash = digest_data
('SHA256', $header_data);
169 $got_header_hash eq $header_hash
170 or throw
'Data is corrupt (header checksum mismatch)',
171 got
=> $got_header_hash, expected
=> $header_hash;
173 $key = $kdbx->composite_key($key);
174 my $transformed_key = $kdbx->kdf->transform($key);
175 push @cleanup, erase_scoped
$transformed_key;
177 # authentication check
178 read_all
$fh, my $header_hmac, 32 or throw
'Failed to read header HMAC';
179 my $hmac_key = digest_data
('SHA512', $kdbx->headers->{master_seed
}, $transformed_key, "\x01");
180 push @cleanup, erase_scoped
$hmac_key;
181 my $got_header_hmac = hmac
('SHA256',
182 digest_data
('SHA512', "\xff\xff\xff\xff\xff\xff\xff\xff", $hmac_key),
185 $got_header_hmac eq $header_hmac
186 or throw
"Invalid credentials or data is corrupt (header HMAC mismatch)\n",
187 got
=> $got_header_hmac, expected
=> $header_hmac;
191 PerlIO
::via
::File
::KDBX
::HmacBlock-
>push($fh, $hmac_key);
193 my $final_key = digest_data
('SHA256', $kdbx->headers->{master_seed
}, $transformed_key);
194 push @cleanup, erase_scoped
$final_key;
196 my $cipher = $kdbx->cipher(key
=> $final_key);
197 PerlIO
::via
::File
::KDBX
::Crypt-
>push($fh, $cipher);
199 my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS
};
200 if ($compress == COMPRESSION_GZIP
) {
201 require PerlIO
::via
::File
::KDBX
::Compression
;
202 PerlIO
::via
::File
::KDBX
::Compression-
>push($fh);
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);
211 binmode($fh, ':pop') if $compress;
212 binmode($fh, ':pop:pop');
215 sub _read_inner_headers
{
219 while (my ($type, $val) = $self->_read_inner_header($fh)) {
220 last if $type == INNER_HEADER_END
;
224 sub _read_inner_header
{
227 my $kdbx = $self->kdbx;
229 read_all
$fh, my $buf, 1 or throw
'Expected inner header type';
230 my ($type) = unpack('C', $buf);
232 read_all
$fh, $buf, 4 or throw
'Expected inner header size', type
=> $type;
233 my ($size) = unpack('L<', $buf);
237 read_all
$fh, $val, $size or throw
'Expected inner header value', type
=> $type, size
=> $size;
240 $type = KDBX_INNER_HEADER
($type);
242 if ($type == INNER_HEADER_END
) {
245 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_ID
) {
246 $val = unpack('L<', $val);
247 $kdbx->inner_headers->{$type} = $val;
249 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_KEY
) {
250 $kdbx->inner_headers->{$type} = $val;
252 elsif ($type == INNER_HEADER_BINARY
) {
253 my $msize = $size - 1;
254 my ($flags, $data) = unpack("C a$msize", $val);
255 my $id = scalar keys %{$kdbx->binaries};
256 $kdbx->binaries->{$id} = {
258 $flags & INNER_HEADER_BINARY_FLAG_PROTECT
? (protect
=> true
) : (),
262 return wantarray ? ($type => $val) : $type;