line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package File::KDBX::Dumper::V3; |
2
|
|
|
|
|
|
|
# ABSTRACT: Dump KDBX3 files |
3
|
|
|
|
|
|
|
|
4
|
5
|
|
|
5
|
|
2211
|
use warnings; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
148
|
|
5
|
5
|
|
|
5
|
|
28
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
98
|
|
6
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
22
|
use Crypt::Digest qw(digest_data); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
173
|
|
8
|
5
|
|
|
5
|
|
24
|
use Encode qw(encode); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
189
|
|
9
|
5
|
|
|
5
|
|
27
|
use File::KDBX::Constants qw(:header :compression); |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
734
|
|
10
|
5
|
|
|
5
|
|
32
|
use File::KDBX::Error; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
237
|
|
11
|
5
|
|
|
5
|
|
795
|
use File::KDBX::IO::Crypt; |
|
5
|
|
|
|
|
16
|
|
|
5
|
|
|
|
|
218
|
|
12
|
5
|
|
|
5
|
|
1201
|
use File::KDBX::IO::HashBlock; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
194
|
|
13
|
5
|
|
|
5
|
|
28
|
use File::KDBX::Util qw(:class :empty :int :load erase_scoped); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
777
|
|
14
|
5
|
|
|
5
|
|
31
|
use IO::Handle; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
131
|
|
15
|
5
|
|
|
5
|
|
21
|
use namespace::clean; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
21
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
extends 'File::KDBX::Dumper'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = '0.906'; # VERSION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub _write_headers { |
22
|
8
|
|
|
8
|
|
17
|
my $self = shift; |
23
|
8
|
|
|
|
|
10
|
my $fh = shift; |
24
|
|
|
|
|
|
|
|
25
|
8
|
|
|
|
|
20
|
my $kdbx = $self->kdbx; |
26
|
8
|
|
|
|
|
26
|
my $headers = $kdbx->headers; |
27
|
8
|
|
|
|
|
16
|
my $buf = ''; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# FIXME kinda janky - maybe add a "prepare" hook to massage the KDBX into the correct shape before we get |
30
|
|
|
|
|
|
|
# this far |
31
|
8
|
|
|
|
|
26
|
local $headers->{+HEADER_TRANSFORM_SEED} = $kdbx->transform_seed; |
32
|
8
|
|
|
|
|
29
|
local $headers->{+HEADER_TRANSFORM_ROUNDS} = $kdbx->transform_rounds; |
33
|
|
|
|
|
|
|
|
34
|
8
|
|
|
|
|
20
|
my $got_iv_size = length($headers->{+HEADER_ENCRYPTION_IV}); |
35
|
8
|
50
|
|
|
|
19
|
alert 'Encryption IV should be exactly 16 bytes long', |
36
|
|
|
|
|
|
|
got => $got_iv_size, |
37
|
|
|
|
|
|
|
expected => 16 if $got_iv_size != 16; |
38
|
|
|
|
|
|
|
|
39
|
8
|
50
|
|
|
|
35
|
if (nonempty (my $comment = $headers->{+HEADER_COMMENT})) { |
40
|
0
|
|
|
|
|
0
|
$buf .= $self->_write_header($fh, HEADER_COMMENT, $comment); |
41
|
|
|
|
|
|
|
} |
42
|
8
|
|
|
|
|
30
|
for my $type ( |
43
|
|
|
|
|
|
|
HEADER_CIPHER_ID, |
44
|
|
|
|
|
|
|
HEADER_COMPRESSION_FLAGS, |
45
|
|
|
|
|
|
|
HEADER_MASTER_SEED, |
46
|
|
|
|
|
|
|
HEADER_TRANSFORM_SEED, |
47
|
|
|
|
|
|
|
HEADER_TRANSFORM_ROUNDS, |
48
|
|
|
|
|
|
|
HEADER_ENCRYPTION_IV, |
49
|
|
|
|
|
|
|
HEADER_INNER_RANDOM_STREAM_KEY, |
50
|
|
|
|
|
|
|
HEADER_STREAM_START_BYTES, |
51
|
|
|
|
|
|
|
HEADER_INNER_RANDOM_STREAM_ID, |
52
|
|
|
|
|
|
|
) { |
53
|
72
|
50
|
|
|
|
141
|
defined $headers->{$type} or throw "Missing value for required header: $type", type => $type; |
54
|
72
|
|
|
|
|
145
|
$buf .= $self->_write_header($fh, $type, $headers->{$type}); |
55
|
|
|
|
|
|
|
} |
56
|
8
|
|
|
|
|
28
|
$buf .= $self->_write_header($fh, HEADER_END); |
57
|
|
|
|
|
|
|
|
58
|
8
|
|
|
|
|
38
|
return $buf; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub _write_header { |
62
|
80
|
|
|
80
|
|
101
|
my $self = shift; |
63
|
80
|
|
|
|
|
83
|
my $fh = shift; |
64
|
80
|
|
|
|
|
91
|
my $type = shift; |
65
|
80
|
|
100
|
|
|
410
|
my $val = shift // ''; |
66
|
|
|
|
|
|
|
|
67
|
80
|
|
|
|
|
155
|
$type = to_header_constant($type); |
68
|
80
|
100
|
0
|
|
|
310
|
if ($type == HEADER_END) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
69
|
8
|
|
|
|
|
23
|
$val = "\r\n\r\n"; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
elsif ($type == HEADER_COMMENT) { |
72
|
0
|
|
|
|
|
0
|
$val = encode('UTF-8', $val); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
elsif ($type == HEADER_CIPHER_ID) { |
75
|
8
|
|
|
|
|
15
|
my $size = length($val); |
76
|
8
|
50
|
|
|
|
21
|
$size == 16 or throw 'Invalid cipher UUID length', got => $size, expected => $size; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
elsif ($type == HEADER_COMPRESSION_FLAGS) { |
79
|
8
|
|
|
|
|
20
|
$val = pack('L<', $val); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
elsif ($type == HEADER_MASTER_SEED) { |
82
|
8
|
|
|
|
|
12
|
my $size = length($val); |
83
|
8
|
50
|
|
|
|
23
|
$size == 32 or throw 'Invalid master seed length', got => $size, expected => $size; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
elsif ($type == HEADER_TRANSFORM_SEED) { |
86
|
|
|
|
|
|
|
# nothing |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
elsif ($type == HEADER_TRANSFORM_ROUNDS) { |
89
|
8
|
|
|
|
|
29
|
$val = pack_Ql($val); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
elsif ($type == HEADER_ENCRYPTION_IV) { |
92
|
|
|
|
|
|
|
# nothing |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
elsif ($type == HEADER_INNER_RANDOM_STREAM_KEY) { |
95
|
|
|
|
|
|
|
# nothing |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
elsif ($type == HEADER_STREAM_START_BYTES) { |
98
|
|
|
|
|
|
|
# nothing |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) { |
101
|
8
|
|
|
|
|
24
|
$val = pack('L<', $val); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
elsif ($type == HEADER_KDF_PARAMETERS || |
104
|
|
|
|
|
|
|
$type == HEADER_PUBLIC_CUSTOM_DATA) { |
105
|
0
|
|
|
|
|
0
|
throw "Unexpected KDBX4 header: $type", type => $type; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
elsif ($type == HEADER_COMMENT) { |
108
|
0
|
|
|
|
|
0
|
throw "Unexpected KDB header: $type", type => $type; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else { |
111
|
0
|
|
|
|
|
0
|
alert "Unknown header: $type", type => $type; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
80
|
|
|
|
|
99
|
my $size = length($val); |
115
|
80
|
|
|
|
|
156
|
my $buf = pack('C S<', 0+$type, $size); |
116
|
|
|
|
|
|
|
|
117
|
80
|
50
|
|
|
|
155
|
$fh->print($buf, $val) or throw 'Failed to write header'; |
118
|
|
|
|
|
|
|
|
119
|
80
|
|
|
|
|
870
|
return "$buf$val"; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub _write_body { |
123
|
8
|
|
|
8
|
|
17
|
my $self = shift; |
124
|
8
|
|
|
|
|
13
|
my $fh = shift; |
125
|
8
|
|
|
|
|
12
|
my $key = shift; |
126
|
8
|
|
|
|
|
13
|
my $header_data = shift; |
127
|
8
|
|
|
|
|
20
|
my $kdbx = $self->kdbx; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# assert all required headers present |
130
|
8
|
|
|
|
|
25
|
for my $field ( |
131
|
|
|
|
|
|
|
HEADER_CIPHER_ID, |
132
|
|
|
|
|
|
|
HEADER_ENCRYPTION_IV, |
133
|
|
|
|
|
|
|
HEADER_MASTER_SEED, |
134
|
|
|
|
|
|
|
HEADER_INNER_RANDOM_STREAM_KEY, |
135
|
|
|
|
|
|
|
HEADER_STREAM_START_BYTES, |
136
|
|
|
|
|
|
|
) { |
137
|
40
|
50
|
|
|
|
74
|
defined $kdbx->headers->{$field} or throw "Missing $field"; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
8
|
|
|
|
|
26
|
my $master_seed = $kdbx->headers->{+HEADER_MASTER_SEED}; |
141
|
|
|
|
|
|
|
|
142
|
8
|
|
|
|
|
13
|
my @cleanup; |
143
|
8
|
|
|
|
|
38
|
$key = $kdbx->composite_key($key); |
144
|
|
|
|
|
|
|
|
145
|
8
|
|
|
|
|
38
|
my $response = $key->challenge($master_seed); |
146
|
8
|
|
|
|
|
32
|
push @cleanup, erase_scoped $response; |
147
|
|
|
|
|
|
|
|
148
|
8
|
|
|
|
|
132
|
my $transformed_key = $kdbx->kdf->transform($key); |
149
|
8
|
|
|
|
|
46
|
push @cleanup, erase_scoped $transformed_key; |
150
|
|
|
|
|
|
|
|
151
|
8
|
|
|
|
|
150
|
my $final_key = digest_data('SHA256', $master_seed, $response, $transformed_key); |
152
|
8
|
|
|
|
|
40
|
push @cleanup, erase_scoped $final_key; |
153
|
|
|
|
|
|
|
|
154
|
8
|
|
|
|
|
110
|
my $cipher = $kdbx->cipher(key => $final_key); |
155
|
8
|
|
|
|
|
121
|
$fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher); |
156
|
|
|
|
|
|
|
|
157
|
8
|
50
|
|
|
|
28
|
$fh->print($kdbx->headers->{+HEADER_STREAM_START_BYTES}) |
158
|
|
|
|
|
|
|
or throw 'Failed to write start bytes'; |
159
|
|
|
|
|
|
|
|
160
|
8
|
|
|
|
|
40
|
$kdbx->key($key); |
161
|
|
|
|
|
|
|
|
162
|
8
|
|
|
|
|
74
|
$fh = File::KDBX::IO::HashBlock->new($fh); |
163
|
|
|
|
|
|
|
|
164
|
8
|
|
|
|
|
28
|
my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS}; |
165
|
8
|
50
|
|
|
|
36
|
if ($compress == COMPRESSION_GZIP) { |
|
|
0
|
|
|
|
|
|
166
|
8
|
|
|
|
|
36
|
load_optional('IO::Compress::Gzip'); |
167
|
8
|
50
|
|
|
|
64
|
$fh = IO::Compress::Gzip->new($fh, |
168
|
|
|
|
|
|
|
-Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(), |
169
|
|
|
|
|
|
|
-TextFlag => 1, |
170
|
|
|
|
|
|
|
) or throw "Failed to initialize compression library: $IO::Compress::Gzip::GzipError", |
171
|
|
|
|
|
|
|
error => $IO::Compress::Gzip::GzipError; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
elsif ($compress != COMPRESSION_NONE) { |
174
|
0
|
|
|
|
|
0
|
throw "Unsupported compression ($compress)\n", compression_flags => $compress; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
8
|
|
|
|
|
307
|
my $header_hash = digest_data('SHA256', $header_data); |
178
|
8
|
|
|
|
|
88
|
$self->_write_inner_body($fh, $header_hash); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
1; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
__END__ |