]> Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Key/File.pm
Version 0.900
[chaz/p5-File-KDBX] / lib / File / KDBX / Key / File.pm
1 package File::KDBX::Key::File;
2 # ABSTRACT: A file key
3
4 use warnings;
5 use strict;
6
7 use Crypt::Digest qw(digest_data);
8 use Crypt::Misc 0.029 qw(decode_b64 encode_b64);
9 use Crypt::PRNG qw(random_bytes);
10 use File::KDBX::Constants qw(:key_file);
11 use File::KDBX::Error;
12 use File::KDBX::Util qw(:class :erase trim);
13 use Ref::Util qw(is_ref is_scalarref);
14 use Scalar::Util qw(openhandle);
15 use XML::LibXML::Reader;
16 use namespace::clean;
17
18 extends 'File::KDBX::Key';
19
20 our $VERSION = '0.900'; # VERSION
21
22
23 has 'type', is => 'ro';
24 has 'version', is => 'ro';
25 has 'filepath', is => 'ro';
26
27
28 sub init { shift->load(@_) }
29
30 sub load {
31 my $self = shift;
32 my $primitive = shift // throw 'Missing key primitive';
33
34 my $data;
35 my $cleanup;
36
37 if (openhandle($primitive)) {
38 seek $primitive, 0, 0; # not using ->seek method so it works on perl 5.10
39 my $buf = do { local $/; <$primitive> };
40 $data = \$buf;
41 $cleanup = erase_scoped $data;
42 }
43 elsif (is_scalarref($primitive)) {
44 $data = $primitive;
45 }
46 elsif (defined $primitive && !is_ref($primitive)) {
47 open(my $fh, '<:raw', $primitive)
48 or throw "Failed to open key file ($primitive)", filepath => $primitive;
49 my $buf = do { local $/; <$fh> };
50 $data = \$buf;
51 $cleanup = erase_scoped $data;
52 $self->{filepath} = $primitive;
53 }
54 else {
55 throw 'Unexpected primitive type', type => ref $primitive;
56 }
57
58 my $raw_key;
59 if (substr($$data, 0, 120) =~ /<KeyFile>/
60 and my ($type, $version) = $self->_load_xml($data, \$raw_key)) {
61 $self->{type} = $type;
62 $self->{version} = $version;
63 $self->_set_raw_key($raw_key);
64 }
65 elsif (length($$data) == 32) {
66 $self->{type} = KEY_FILE_TYPE_BINARY;
67 $self->_set_raw_key($$data);
68 }
69 elsif ($$data =~ /^[A-Fa-f0-9]{64}$/) {
70 $self->{type} = KEY_FILE_TYPE_HEX;
71 $self->_set_raw_key(pack('H64', $$data));
72 }
73 else {
74 $self->{type} = KEY_FILE_TYPE_HASHED;
75 $self->_set_raw_key(digest_data('SHA256', $$data));
76 }
77
78 return $self->hide;
79 }
80
81
82 sub reload {
83 my $self = shift;
84 $self->init($self->{filepath}) if defined $self->{filepath};
85 return $self;
86 }
87
88
89 sub save {
90 my $self = shift;
91 my %args = @_;
92
93 my @cleanup;
94 my $raw_key = $args{raw_key} // $self->raw_key // random_bytes(32);
95 push @cleanup, erase_scoped $raw_key;
96 length($raw_key) == 32 or throw 'Raw key must be exactly 256 bits (32 bytes)', length => length($raw_key);
97
98 my $type = $args{type} // $self->type // KEY_FILE_TYPE_XML;
99 my $version = $args{version} // $self->version // 2;
100 my $filepath = $args{filepath} // $self->filepath;
101 my $fh = $args{fh};
102
103 my $filepath_temp;
104 if (!openhandle($fh)) {
105 $filepath or throw 'Must specify where to safe the key file to';
106
107 require File::Temp;
108 ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) };
109 if (!$fh or my $err = $@) {
110 $err //= 'Unknown error';
111 throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
112 error => $err,
113 filepath => $filepath_temp;
114 }
115 }
116
117 if ($type == KEY_FILE_TYPE_XML) {
118 $self->_save_xml($fh, $raw_key, $version);
119 }
120 elsif ($type == KEY_FILE_TYPE_BINARY) {
121 print $fh $raw_key;
122 }
123 elsif ($type == KEY_FILE_TYPE_HEX) {
124 my $hex = uc(unpack('H*', $raw_key));
125 push @cleanup, erase_scoped $hex;
126 print $fh $hex;
127 }
128 else {
129 throw "Cannot save $type key file (invalid type)", type => $type;
130 }
131
132 close($fh);
133
134 if ($filepath_temp) {
135 my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
136
137 my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
138 my $uid = $args{uid} // $file_uid // -1;
139 my $gid = $args{gid} // $file_gid // -1;
140 chmod($mode, $filepath_temp) if defined $mode;
141 chown($uid, $gid, $filepath_temp);
142 rename($filepath_temp, $filepath)
143 or throw "Failed to write file ($filepath): $!", filepath => $filepath;
144 }
145 }
146
147 ##############################################################################
148
149 sub _load_xml {
150 my $self = shift;
151 my $buf = shift;
152 my $out = shift;
153
154 my ($version, $hash, $data);
155
156 my $reader = XML::LibXML::Reader->new(string => $$buf);
157 my $pattern = XML::LibXML::Pattern->new('/KeyFile/Meta/Version|/KeyFile/Key/Data');
158
159 while ($reader->nextPatternMatch($pattern) == 1) {
160 next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
161 my $name = $reader->localName;
162 if ($name eq 'Version') {
163 $reader->read if !$reader->isEmptyElement;
164 $reader->nodeType == XML_READER_TYPE_TEXT
165 or alert 'Expected text node with version', line => $reader->lineNumber;
166 my $val = trim($reader->value);
167 defined $version
168 and alert 'Overwriting version', previous => $version, new => $val, line => $reader->lineNumber;
169 $version = $val;
170 }
171 elsif ($name eq 'Data') {
172 $hash = trim($reader->getAttribute('Hash')) if $reader->hasAttributes;
173 $reader->read if !$reader->isEmptyElement;
174 $reader->nodeType == XML_READER_TYPE_TEXT
175 or alert 'Expected text node with data', line => $reader->lineNumber;
176 $data = $reader->value;
177 $data =~ s/\s+//g if defined $data;
178 }
179 }
180
181 return if !defined $version || !defined $data;
182
183 if ($version =~ /^1\.0/ && $data =~ /^[A-Za-z0-9+\/=]+$/) {
184 $$out = eval { decode_b64($data) };
185 if (my $err = $@) {
186 throw 'Failed to decode key in key file', version => $version, data => $data, error => $err;
187 }
188 return (KEY_FILE_TYPE_XML, $version);
189 }
190 elsif ($version =~ /^2\.0/ && $data =~ /^[A-Fa-f0-9]+$/ && defined $hash && $hash =~ /^[A-Fa-f0-9]+$/) {
191 $$out = pack('H*', $data);
192 $hash = pack('H*', $hash);
193 my $got_hash = digest_data('SHA256', $$out);
194 $hash eq substr($got_hash, 0, length($hash))
195 or throw 'Checksum mismatch', got => $got_hash, expected => $hash;
196 return (KEY_FILE_TYPE_XML, $version);
197 }
198
199 throw 'Unexpected data in key file', version => $version, data => $data;
200 }
201
202 sub _save_xml {
203 my $self = shift;
204 my $fh = shift;
205 my $raw_key = shift;
206 my $version = shift // 2;
207
208 my @cleanup;
209
210 my $dom = XML::LibXML::Document->new('1.0', 'UTF-8');
211 my $doc = XML::LibXML::Element->new('KeyFile');
212 $dom->setDocumentElement($doc);
213 my $meta_node = XML::LibXML::Element->new('Meta');
214 $doc->appendChild($meta_node);
215 my $version_node = XML::LibXML::Element->new('Version');
216 $version_node->appendText(sprintf('%.1f', $version));
217 $meta_node->appendChild($version_node);
218 my $key_node = XML::LibXML::Element->new('Key');
219 $doc->appendChild($key_node);
220 my $data_node = XML::LibXML::Element->new('Data');
221 $key_node->appendChild($data_node);
222
223 if (int($version) == 1) {
224 my $b64 = encode_b64($raw_key);
225 push @cleanup, erase_scoped $b64;
226 $data_node->appendText($b64);
227 }
228 elsif (int($version) == 2) {
229 my @hex = unpack('(H8)8', $raw_key);
230 my $hex = uc(sprintf("\n %s\n %s\n ", join(' ', @hex[0..3]), join(' ', @hex[4..7])));
231 push @cleanup, erase_scoped $hex, @hex;
232 $data_node->appendText($hex);
233 my $hash = digest_data('SHA256', $raw_key);
234 substr($hash, 4) = '';
235 $hash = uc(unpack('H*', $hash));
236 $data_node->setAttribute('Hash', $hash);
237 }
238 else {
239 throw 'Failed to save unsupported key file version', version => $version;
240 }
241
242 $dom->toFH($fh, 1);
243 }
244
245 1;
246
247 __END__
248
249 =pod
250
251 =encoding UTF-8
252
253 =head1 NAME
254
255 File::KDBX::Key::File - A file key
256
257 =head1 VERSION
258
259 version 0.900
260
261 =head1 SYNOPSIS
262
263 use File::KDBX::Constants qw(:key_file);
264 use File::KDBX::Key::File;
265
266 ### Create a key file:
267
268 my $key = File::KDBX::Key::File->new(
269 filepath => 'path/to/file.keyx',
270 type => KEY_FILE_TYPE_XML, # optional
271 version => 2, # optional
272 raw_key => $raw_key, # optional - leave undefined to generate a random key
273 );
274 $key->save;
275
276 ### Use a key file:
277
278 my $key2 = File::KDBX::Key::File->new('path/to/file.keyx');
279 # OR
280 my $key2 = File::KDBX::Key::File->new(\$secret);
281 # OR
282 my $key2 = File::KDBX::Key::File->new($fh); # or *IO
283
284 =head1 DESCRIPTION
285
286 A file key (or "key file") is the type of key where the secret is a file. The secret is either the file
287 contents or is generated based on the file contents. In order to lock and unlock a KDBX database with a key
288 file, the same file must be presented. The database cannot be opened without the file.
289
290 Inherets methods and attributes from L<File::KDBX::Key>.
291
292 There are multiple types of key files supported. See L</type>. This module can read and write key files.
293
294 =head1 ATTRIBUTES
295
296 =head2 type
297
298 $type = $key->type;
299
300 Get the type of key file. Can be one of from L<File::KDBX::Constants/":key_file">:
301
302 =over 4
303
304 =item *
305
306 C<KEY_FILE_TYPE_BINARY>
307
308 =item *
309
310 C<KEY_FILE_TYPE_HEX>
311
312 =item *
313
314 C<KEY_FILE_TYPE_XML>
315
316 =item *
317
318 C<KEY_FILE_TYPE_HASHED>
319
320 =back
321
322 =head2 version
323
324 $version = $key->version;
325
326 Get the file version. Only applies to XML key files.
327
328 =head2 filepath
329
330 $filepath = $key->filepath;
331
332 Get the filepath to the key file, if known.
333
334 =head1 METHODS
335
336 =head2 load
337
338 $key = $key->load($filepath);
339 $key = $key->load(\$string);
340 $key = $key->load($fh);
341 $key = $key->load(*IO);
342
343 Load a key file.
344
345 =head2 reload
346
347 $key->reload;
348
349 Re-read the key file, if possible, and update the raw key if the key changed.
350
351 =head2 save
352
353 $key->save;
354 $key->save(%options);
355
356 Write a key file. Available options:
357
358 =over 4
359
360 =item *
361
362 C<type> - Type of key file (default: value of L</type>, or C<KEY_FILE_TYPE_XML>)
363
364 =item *
365
366 C<verson> - Version of key file (default: value of L</version>, or 2)
367
368 =item *
369
370 C<filepath> - Where to save the file (default: value of L</filepath>)
371
372 =item *
373
374 C<fh> - IO handle to write to (overrides C<filepath>, one of which must be defined)
375
376 =item *
377
378 C<raw_key> - Raw key (default: value of L</raw_key>)
379
380 =back
381
382 =head1 BUGS
383
384 Please report any bugs or feature requests on the bugtracker website
385 L<https://github.com/chazmcgarvey/File-KDBX/issues>
386
387 When submitting a bug or request, please include a test-file or a
388 patch to an existing test-file that illustrates the bug or desired
389 feature.
390
391 =head1 AUTHOR
392
393 Charles McGarvey <ccm@cpan.org>
394
395 =head1 COPYRIGHT AND LICENSE
396
397 This software is copyright (c) 2022 by Charles McGarvey.
398
399 This is free software; you can redistribute it and/or modify it under
400 the same terms as the Perl 5 programming language system itself.
401
402 =cut
This page took 0.057623 seconds and 4 git commands to generate.