1 package File
::KDBX
::Dumper
::V4
;
2 # ABSTRACT: Dump KDBX4 files
7 use Crypt
::Digest
qw(digest_data);
8 use Crypt
::Mac
::HMAC
qw(hmac);
9 use Encode
qw(encode is_utf8);
10 use File
::KDBX
::Constants
qw(:header :inner_header :compression :kdf :variant_map);
11 use File
::KDBX
::Error
;
12 use File
::KDBX
::IO
::Crypt
;
13 use File
::KDBX
::IO
::HmacBlock
;
14 use File
::KDBX
::Util
qw(:empty assert_64bit erase_scoped);
16 use Scalar
::Util
qw(looks_like_number);
20 use parent
'File::KDBX::Dumper';
22 our $VERSION = '999.999'; # VERSION
24 sub _binaries_written
{ $_[0]->{_binaries_written
} //= {} }
30 my $kdbx = $self->kdbx;
31 my $headers = $kdbx->headers;
34 # Always write the standard AES KDF UUID, for compatibility
35 local $headers->{+HEADER_KDF_PARAMETERS
}->{+KDF_PARAM_UUID
} = KDF_UUID_AES
36 if $headers->{+HEADER_KDF_PARAMETERS
}->{+KDF_PARAM_UUID
} eq KDF_UUID_AES_CHALLENGE_RESPONSE
;
38 if (nonempty
(my $comment = $headers->{+HEADER_COMMENT
})) {
39 $buf .= $self->_write_header($fh, HEADER_COMMENT
, $comment);
43 HEADER_COMPRESSION_FLAGS
,
46 HEADER_KDF_PARAMETERS
,
48 defined $headers->{$type} or throw
"Missing value for required header: $type", type
=> $type;
49 $buf .= $self->_write_header($fh, $type, $headers->{$type});
51 $buf .= $self->_write_header($fh, HEADER_PUBLIC_CUSTOM_DATA
, $headers->{+HEADER_PUBLIC_CUSTOM_DATA
})
52 if defined $headers->{+HEADER_PUBLIC_CUSTOM_DATA
} && keys %{$headers->{+HEADER_PUBLIC_CUSTOM_DATA
}};
53 $buf .= $self->_write_header($fh, HEADER_END
);
62 my $val = shift // '';
64 $type = KDBX_HEADER
($type);
65 if ($type == HEADER_END
) {
68 elsif ($type == HEADER_COMMENT
) {
69 $val = encode
('UTF-8', $val);
71 elsif ($type == HEADER_CIPHER_ID
) {
72 my $size = length($val);
73 $size == 16 or throw
'Invalid cipher UUID length', got
=> $size, expected
=> $size;
75 elsif ($type == HEADER_COMPRESSION_FLAGS
) {
76 $val = pack('L<', $val);
78 elsif ($type == HEADER_MASTER_SEED
) {
79 my $size = length($val);
80 $size == 32 or throw
'Invalid master seed length', got
=> $size, expected
=> $size;
82 elsif ($type == HEADER_ENCRYPTION_IV
) {
85 elsif ($type == HEADER_KDF_PARAMETERS
) {
86 $val = $self->_write_variant_dictionary($val, {
87 KDF_PARAM_UUID
() => VMAP_TYPE_BYTEARRAY
,
88 KDF_PARAM_AES_ROUNDS
() => VMAP_TYPE_UINT64
,
89 KDF_PARAM_AES_SEED
() => VMAP_TYPE_BYTEARRAY
,
90 KDF_PARAM_ARGON2_SALT
() => VMAP_TYPE_BYTEARRAY
,
91 KDF_PARAM_ARGON2_PARALLELISM
() => VMAP_TYPE_UINT32
,
92 KDF_PARAM_ARGON2_MEMORY
() => VMAP_TYPE_UINT64
,
93 KDF_PARAM_ARGON2_ITERATIONS
() => VMAP_TYPE_UINT64
,
94 KDF_PARAM_ARGON2_VERSION
() => VMAP_TYPE_UINT32
,
95 KDF_PARAM_ARGON2_SECRET
() => VMAP_TYPE_BYTEARRAY
,
96 KDF_PARAM_ARGON2_ASSOCDATA
() => VMAP_TYPE_BYTEARRAY
,
99 elsif ($type == HEADER_PUBLIC_CUSTOM_DATA
) {
100 $val = $self->_write_variant_dictionary($val);
102 elsif ($type == HEADER_INNER_RANDOM_STREAM_ID
||
103 $type == HEADER_INNER_RANDOM_STREAM_KEY
||
104 $type == HEADER_TRANSFORM_SEED
||
105 $type == HEADER_TRANSFORM_ROUNDS
||
106 $type == HEADER_STREAM_START_BYTES
) {
107 throw
"Unexpected KDBX3 header: $type", type
=> $type;
109 elsif ($type == HEADER_COMMENT
) {
110 throw
"Unexpected KDB header: $type", type
=> $type;
113 alert
"Unknown header: $type", type
=> $type;
116 my $size = length($val);
117 my $buf = pack('C L<', 0+$type, $size);
119 $fh->print($buf, $val) or throw
'Failed to write header';
124 sub _intuit_variant_type
{
128 if (isBoolean
($variant)) {
129 return VMAP_TYPE_BOOL
;
131 elsif (looks_like_number
($variant) && ($variant + 0) =~ /^\d+$/) {
133 my $neg = $variant < 0;
134 my @b = unpack('L>2', pack('Q>', $variant));
135 return VMAP_TYPE_INT64
if $b[0] && $neg;
136 return VMAP_TYPE_UINT64
if $b[0];
137 return VMAP_TYPE_INT32
if $neg;
138 return VMAP_TYPE_UINT32
;
140 elsif (is_utf8
($variant)) {
141 return VMAP_TYPE_STRING
;
143 return VMAP_TYPE_BYTEARRAY
;
146 sub _write_variant_dictionary
{
148 my $dict = shift || {};
149 my $types = shift || {};
153 $buf .= pack('S<', VMAP_VERSION
);
155 for my $key (sort keys %$dict) {
156 my $val = $dict->{$key};
158 my $type = $types->{$key} // $self->_intuit_variant_type($val);
159 $buf .= pack('C', $type);
161 if ($type == VMAP_TYPE_UINT32
) {
162 $val = pack('L<', $val);
164 elsif ($type == VMAP_TYPE_UINT64
) {
166 $val = pack('Q<', $val);
168 elsif ($type == VMAP_TYPE_BOOL
) {
169 $val = pack('C', $val);
171 elsif ($type == VMAP_TYPE_INT32
) {
172 $val = pack('l', $val);
174 elsif ($type == VMAP_TYPE_INT64
) {
176 $val = pack('q<', $val);
178 elsif ($type == VMAP_TYPE_STRING
) {
179 $val = encode
('UTF-8', $val);
181 elsif ($type == VMAP_TYPE_BYTEARRAY
) {
182 # $val = substr($$buf, $pos, $vlen);
183 # $val = [split //, $val];
186 throw
'Unknown variant dictionary value type', type
=> $type;
189 my ($klen, $vlen) = (length($key), length($val));
190 $buf .= pack("L< a$klen L< a$vlen", $klen, $key, $vlen, $val);
193 $buf .= pack('C', VMAP_TYPE_END
);
202 my $header_data = shift;
203 my $kdbx = $self->kdbx;
205 # assert all required headers present
208 HEADER_ENCRYPTION_IV
,
211 defined $kdbx->headers->{$field} or throw
"Missing header: $field";
216 # write 32-byte checksum
217 my $header_hash = digest_data
('SHA256', $header_data);
218 $fh->print($header_hash) or throw
'Failed to write header hash';
220 $key = $kdbx->composite_key($key);
221 my $transformed_key = $kdbx->kdf->transform($key);
222 push @cleanup, erase_scoped
$transformed_key;
224 # write 32-byte HMAC for header
225 my $hmac_key = digest_data
('SHA512', $kdbx->headers->{master_seed
}, $transformed_key, "\x01");
226 push @cleanup, erase_scoped
$hmac_key;
227 my $header_hmac = hmac
('SHA256',
228 digest_data
('SHA512', "\xff\xff\xff\xff\xff\xff\xff\xff", $hmac_key),
231 $fh->print($header_hmac) or throw
'Failed to write header HMAC';
235 # HMAC-block the rest of the stream
236 $fh = File
::KDBX
::IO
::HmacBlock-
>new($fh, key
=> $hmac_key);
238 my $final_key = digest_data
('SHA256', $kdbx->headers->{master_seed
}, $transformed_key);
239 push @cleanup, erase_scoped
$final_key;
241 my $cipher = $kdbx->cipher(key
=> $final_key);
242 $fh = File
::KDBX
::IO
::Crypt-
>new($fh, cipher
=> $cipher);
244 my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS
};
245 if ($compress == COMPRESSION_GZIP
) {
246 require IO
::Compress
::Gzip
;
247 $fh = IO
::Compress
::Gzip-
>new($fh,
248 -Level
=> IO
::Compress
::Gzip
::Z_BEST_COMPRESSION
(),
250 ) or throw
"Failed to initialize compression library: $IO::Compress::Gzip::GzipError",
251 error
=> $IO::Compress
::Gzip
::GzipError
;
253 elsif ($compress != COMPRESSION_NONE
) {
254 throw
"Unsupported compression ($compress)\n", compression_flags
=> $compress;
257 $self->_write_inner_headers($fh);
259 local $self->{compress_datetimes
} = 1;
260 $self->_write_inner_body($fh, $header_hash);
263 sub _write_inner_headers
{
267 my $kdbx = $self->kdbx;
268 my $headers = $kdbx->inner_headers;
271 INNER_HEADER_INNER_RANDOM_STREAM_ID
,
272 INNER_HEADER_INNER_RANDOM_STREAM_KEY
,
274 defined $headers->{$type} or throw
"Missing inner header: $type";
275 $self->_write_inner_header($fh, $type => $headers->{$type});
278 $self->_write_binaries($fh);
280 $self->_write_inner_header($fh, INNER_HEADER_END
);
283 sub _write_inner_header
{
287 my $val = shift // '';
289 my $buf = pack('C', $type);
290 $fh->print($buf) or throw
'Failed to write inner header type';
292 $type = KDBX_INNER_HEADER
($type);
294 if ($type == INNER_HEADER_END
) {
297 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_ID
) {
298 $val = pack('L<', $val);
300 elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_KEY
) {
303 elsif ($type == INNER_HEADER_BINARY
) {
307 $buf = pack('L<', length($val));
308 $fh->print($buf) or throw
'Failed to write inner header value size';
309 $fh->print($val) or throw
'Failed to write inner header value';
312 sub _write_binaries
{
316 my $kdbx = $self->kdbx;
319 my $written = $self->_binaries_written;
321 my $entries = $kdbx->all_entries(history
=> true
);
322 for my $entry (@$entries) {
323 for my $key (keys %{$entry->binaries}) {
324 my $binary = $entry->binaries->{$key};
325 if (defined $binary->{ref} && defined $kdbx->binaries->{$binary->{ref}}) {
326 $binary = $kdbx->binaries->{$binary->{ref}};
329 if (!defined $binary->{value
}) {
330 alert
"Skipping binary which has no value: $key", key
=> $key;
334 my $hash = digest_data
('SHA256', $binary->{value
});
335 if (defined $written->{$hash}) {
340 $flags &= INNER_HEADER_BINARY_FLAG_PROTECT
if $binary->{protect
};
342 $self->_write_binary($fh, \
$binary->{value
}, $flags);
343 $written->{$hash} = $new_ref++;
353 my $flags = shift || 0;
355 my $buf = pack('C', 0 + INNER_HEADER_BINARY
);
356 $fh->print($buf) or throw
'Failed to write inner header type';
358 $buf = pack('L<', 1 + length($$data));
359 $fh->print($buf) or throw
'Failed to write inner header value size';
361 $buf = pack('C', $flags);
362 $fh->print($buf) or throw
'Failed to write inner header binary flags';
364 $fh->print($$data) or throw
'Failed to write inner header value';