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