File Coverage

blib/lib/File/KDBX/Key/File.pm
Criterion Covered Total %
statement 173 181 95.5
branch 56 82 68.2
condition 38 74 51.3
subroutine 21 21 100.0
pod 7 7 100.0
total 295 365 80.8


line stmt bran cond sub pod time code
1             package File::KDBX::Key::File;
2             # ABSTRACT: A file key
3              
4 2     2   1163 use warnings;
  2         3  
  2         62  
5 2     2   8 use strict;
  2         4  
  2         44  
6              
7 2     2   11 use Crypt::Digest qw(digest_data);
  2         3  
  2         90  
8 2     2   10 use Crypt::Misc 0.029 qw(decode_b64 encode_b64);
  2         45  
  2         122  
9 2     2   12 use Crypt::PRNG qw(random_bytes);
  2         3  
  2         72  
10 2     2   19 use File::KDBX::Constants qw(:key_file);
  2         4  
  2         216  
11 2     2   11 use File::KDBX::Error;
  2         3  
  2         94  
12 2     2   20 use File::KDBX::Util qw(:class :erase trim);
  2         4  
  2         222  
13 2     2   12 use Ref::Util qw(is_ref is_scalarref);
  2         3  
  2         98  
14 2     2   10 use Scalar::Util qw(openhandle);
  2         10  
  2         70  
15 2     2   415 use XML::LibXML::Reader;
  2         27518  
  2         205  
16 2     2   12 use namespace::clean;
  2         4  
  2         12  
17              
18             extends 'File::KDBX::Key';
19              
20 21 50   21 1 68 our $VERSION = '0.904'; # VERSION
21 9 50   9 1 24  
22 21 50 50 7 1 89  
  7         16  
23 9   100     41 has 'type', is => 'ro';
24 7   100     23 has 'version', is => 'ro';
25             has 'filepath', is => 'ro';
26              
27              
28 37     37 1 630 sub init { shift->load(@_) }
29              
30             sub load {
31 37     37 1 61 my $self = shift;
32 37   66     122 my $primitive = shift // throw 'Missing key primitive';
33              
34 36         65 my $data;
35             my $cleanup;
36              
37 36 100 66     163 if (openhandle($primitive)) {
    100          
    100          
38 1         9 seek $primitive, 0, 0; # not using ->seek method so it works on perl 5.10
39 1         2 my $buf = do { local $/; <$primitive> };
  1         3  
  1         5  
40 1         2 $data = \$buf;
41 1         3 $cleanup = erase_scoped $data;
42             }
43             elsif (is_scalarref($primitive)) {
44 20         49 $data = $primitive;
45             }
46             elsif (defined $primitive && !is_ref($primitive)) {
47 14 100       529 open(my $fh, '<:raw', $primitive)
48             or throw "Failed to open key file ($primitive)", filepath => $primitive;
49 13         32 my $buf = do { local $/; <$fh> };
  13         50  
  13         389  
50 13         33 $data = \$buf;
51 13         44 $cleanup = erase_scoped $data;
52 13         279 $self->{filepath} = $primitive;
53             }
54             else {
55 1         6 throw 'Unexpected primitive type', type => ref $primitive;
56             }
57              
58 34         71 my $raw_key;
59 34 100 66     234 if (substr($$data, 0, 120) =~ //
    100          
    100          
60             and my ($type, $version) = $self->_load_xml($data, \$raw_key)) {
61 6         122 $self->{type} = $type;
62 6         10 $self->{version} = $version;
63 6         15 $self->_set_raw_key($raw_key);
64             }
65             elsif (length($$data) == 32) {
66 4         8 $self->{type} = KEY_FILE_TYPE_BINARY;
67 4         12 $self->_set_raw_key($$data);
68             }
69             elsif ($$data =~ /^[A-Fa-f0-9]{64}$/) {
70 2         7 $self->{type} = KEY_FILE_TYPE_HEX;
71 2         11 $self->_set_raw_key(pack('H64', $$data));
72             }
73             else {
74 22         77 $self->{type} = KEY_FILE_TYPE_HASHED;
75 22         162 $self->_set_raw_key(digest_data('SHA256', $$data));
76             }
77              
78 34         111 return $self->hide;
79             }
80              
81              
82             sub reload {
83 2     2 1 7 my $self = shift;
84 2 50       9 $self->init($self->{filepath}) if defined $self->{filepath};
85 2         4 return $self;
86             }
87              
88              
89             sub save {
90 7     7 1 659 my $self = shift;
91 7         11 my %args = @_;
92              
93 7         11 my @cleanup;
94 7   33     24 my $raw_key = $args{raw_key} // $self->raw_key // random_bytes(32);
      33        
95 7         20 push @cleanup, erase_scoped $raw_key;
96 7 50       78 length($raw_key) == 32 or throw 'Raw key must be exactly 256 bits (32 bytes)', length => length($raw_key);
97              
98 7   66     20 my $type = $args{type} // $self->type // KEY_FILE_TYPE_XML;
      50        
99 7   66     27 my $version = $args{version} // $self->version // 2;
      100        
100 7   100     18 my $filepath = $args{filepath} // $self->filepath;
101 7         10 my $fh = $args{fh};
102 7   50     18 my $atomic = $args{atomic} // 1;
103              
104 7         7 my $filepath_temp;
105 7 100       15 if (!openhandle($fh)) {
106 6 50       11 $filepath or throw 'Must specify where to safe the key file to';
107              
108 6 50       9 if ($atomic) {
109 6         20 require File::Temp;
110 6         8 ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", UNLINK => 1) };
  6         17  
111 6 50 33     1651 if (!$fh or my $err = $@) {
112 0   0     0 $err //= 'Unknown error';
113 0         0 throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
114             error => $err,
115             filepath => $filepath_temp;
116             }
117             }
118             else {
119 0 0       0 open($fh, '>:raw', $filepath) or throw "Open file failed ($filepath): $!", filepath => $filepath;
120             }
121             }
122              
123 7 100       24 if ($type == KEY_FILE_TYPE_XML) {
    100          
    100          
124 3         8 $self->_save_xml($fh, $raw_key, $version);
125             }
126             elsif ($type == KEY_FILE_TYPE_BINARY) {
127 2         33 print $fh $raw_key;
128             }
129             elsif ($type == KEY_FILE_TYPE_HEX) {
130 1         3 my $hex = uc(unpack('H*', $raw_key));
131 1         4 push @cleanup, erase_scoped $hex;
132 1         29 print $fh $hex;
133             }
134             else {
135 1         8 throw "Cannot save $type key file (invalid type)", type => $type;
136             }
137              
138 6         212 close($fh);
139              
140 6 100       25 if ($filepath_temp) {
141 5         61 my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
142              
143 5 0 33     24 my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
  0   33     0  
  0         0  
144 5   33     15 my $uid = $args{uid} // $file_uid // -1;
      50        
145 5   33     12 my $gid = $args{gid} // $file_gid // -1;
      50        
146 5 50       58 chmod($mode, $filepath_temp) if defined $mode;
147 5         59 chown($uid, $gid, $filepath_temp);
148 5 50       437 rename($filepath_temp, $filepath)
149             or throw "Failed to write file ($filepath): $!", filepath => $filepath;
150             }
151             }
152              
153             ##############################################################################
154              
155             sub _load_xml {
156 6     6   8 my $self = shift;
157 6         9 my $buf = shift;
158 6         9 my $out = shift;
159              
160 6         6 my ($version, $hash, $data);
161              
162 6         26 my $reader = XML::LibXML::Reader->new(string => $$buf);
163 6         401 my $pattern = XML::LibXML::Pattern->new('/KeyFile/Meta/Version|/KeyFile/Key/Data');
164              
165 6         285 while ($reader->nextPatternMatch($pattern) == 1) {
166 24 100       93 next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
167 12         29 my $name = $reader->localName;
168 12 100       30 if ($name eq 'Version') {
    50          
169 6 50       26 $reader->read if !$reader->isEmptyElement;
170 6 50       15 $reader->nodeType == XML_READER_TYPE_TEXT
171             or alert 'Expected text node with version', line => $reader->lineNumber;
172 6         20 my $val = trim($reader->value);
173 6 50       13 defined $version
174             and alert 'Overwriting version', previous => $version, new => $val, line => $reader->lineNumber;
175 6         22 $version = $val;
176             }
177             elsif ($name eq 'Data') {
178 6 100       28 $hash = trim($reader->getAttribute('Hash')) if $reader->hasAttributes;
179 6 50       32 $reader->read if !$reader->isEmptyElement;
180 6 50       13 $reader->nodeType == XML_READER_TYPE_TEXT
181             or alert 'Expected text node with data', line => $reader->lineNumber;
182 6         21 $data = $reader->value;
183 6 50       56 $data =~ s/\s+//g if defined $data;
184             }
185             }
186              
187 6 50 33     21 return if !defined $version || !defined $data;
188              
189 6 100 66     87 if ($version =~ /^1\.0/ && $data =~ /^[A-Za-z0-9+\/=]+$/) {
    50 33        
      33        
      33        
190 2         5 $$out = eval { decode_b64($data) };
  2         9  
191 2 50       5 if (my $err = $@) {
192 0         0 throw 'Failed to decode key in key file', version => $version, data => $data, error => $err;
193             }
194 2         13 return (KEY_FILE_TYPE_XML, $version);
195             }
196             elsif ($version =~ /^2\.0/ && $data =~ /^[A-Fa-f0-9]+$/ && defined $hash && $hash =~ /^[A-Fa-f0-9]+$/) {
197 4         21 $$out = pack('H*', $data);
198 4         8 $hash = pack('H*', $hash);
199 4         21 my $got_hash = digest_data('SHA256', $$out);
200 4 50       12 $hash eq substr($got_hash, 0, length($hash))
201             or throw 'Checksum mismatch', got => $got_hash, expected => $hash;
202 4         25 return (KEY_FILE_TYPE_XML, $version);
203             }
204              
205 0         0 throw 'Unexpected data in key file', version => $version, data => $data;
206             }
207              
208             sub _save_xml {
209 3     3   5 my $self = shift;
210 3         4 my $fh = shift;
211 3         3 my $raw_key = shift;
212 3   50     7 my $version = shift // 2;
213              
214 3         4 my @cleanup;
215              
216 3         21 my $dom = XML::LibXML::Document->new('1.0', 'UTF-8');
217 3         23 my $doc = XML::LibXML::Element->new('KeyFile');
218 3         11 $dom->setDocumentElement($doc);
219 3         38 my $meta_node = XML::LibXML::Element->new('Meta');
220 3         16 $doc->appendChild($meta_node);
221 3         10 my $version_node = XML::LibXML::Element->new('Version');
222 3         103 $version_node->appendText(sprintf('%.1f', $version));
223 3         11 $meta_node->appendChild($version_node);
224 3         7 my $key_node = XML::LibXML::Element->new('Key');
225 3         33 $doc->appendChild($key_node);
226 3         6 my $data_node = XML::LibXML::Element->new('Data');
227 3         32 $key_node->appendChild($data_node);
228              
229 3 100       6 if (int($version) == 1) {
    50          
230 1         13 my $b64 = encode_b64($raw_key);
231 1         2 push @cleanup, erase_scoped $b64;
232 1         14 $data_node->appendText($b64);
233             }
234             elsif (int($version) == 2) {
235 2         29 my @hex = unpack('(H8)8', $raw_key);
236 2         15 my $hex = uc(sprintf("\n %s\n %s\n ", join(' ', @hex[0..3]), join(' ', @hex[4..7])));
237 2         6 push @cleanup, erase_scoped $hex, @hex;
238 2         29 $data_node->appendText($hex);
239 2         11 my $hash = digest_data('SHA256', $raw_key);
240 2         5 substr($hash, 4) = '';
241 2         6 $hash = uc(unpack('H*', $hash));
242 2         6 $data_node->setAttribute('Hash', $hash);
243             }
244             else {
245 0         0 throw 'Failed to save unsupported key file version', version => $version;
246             }
247              
248 3         89 $dom->toFH($fh, 1);
249             }
250              
251             1;
252              
253             __END__