Dogcows Code - chaz/p5-File-KDBX/blob - 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.901'; # 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     my $atomic      = $args{atomic} // 1;
 103
 104     my $filepath_temp;
 105     if (!openhandle($fh)) {
 106         $filepath or throw 'Must specify where to safe the key file to';
 107
 108         if ($atomic) {
 109             require File::Temp;
 110             ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", UNLINK => 1) };
 111             if (!$fh or my $err = $@) {
 112                 $err //= 'Unknown error';
 113                 throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
 114                     error       => $err,
 115                     filepath    => $filepath_temp;
 116             }
 117         }
 118         else {
 119             open($fh, '>:raw', $filepath) or throw "Open file failed ($filepath): $!", filepath => $filepath;
 120         }
 121     }
 122
 123     if ($type == KEY_FILE_TYPE_XML) {
 124         $self->_save_xml($fh, $raw_key, $version);
 125     }
 126     elsif ($type == KEY_FILE_TYPE_BINARY) {
 127         print $fh $raw_key;
 128     }
 129     elsif ($type == KEY_FILE_TYPE_HEX) {
 130         my $hex = uc(unpack('H*', $raw_key));
 131         push @cleanup, erase_scoped $hex;
 132         print $fh $hex;
 133     }
 134     else {
 135         throw "Cannot save $type key file (invalid type)", type => $type;
 136     }
 137
 138     close($fh);
 139
 140     if ($filepath_temp) {
 141         my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
 142
 143         my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
 144         my $uid  = $args{uid}  // $file_uid  // -1;
 145         my $gid  = $args{gid}  // $file_gid  // -1;
 146         chmod($mode, $filepath_temp) if defined $mode;
 147         chown($uid, $gid, $filepath_temp);
 148         rename($filepath_temp, $filepath)
 149             or throw "Failed to write file ($filepath): $!", filepath => $filepath;
 150     }
 151 }
 152
 153 ##############################################################################
 154
 155 sub _load_xml {
 156     my $self = shift;
 157     my $buf  = shift;
 158     my $out  = shift;
 159
 160     my ($version, $hash, $data);
 161
 162     my $reader  = XML::LibXML::Reader->new(string => $$buf);
 163     my $pattern = XML::LibXML::Pattern->new('/KeyFile/Meta/Version|/KeyFile/Key/Data');
 164
 165     while ($reader->nextPatternMatch($pattern) == 1) {
 166         next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
 167         my $name = $reader->localName;
 168         if ($name eq 'Version') {
 169             $reader->read if !$reader->isEmptyElement;
 170             $reader->nodeType == XML_READER_TYPE_TEXT
 171                 or alert 'Expected text node with version', line => $reader->lineNumber;
 172             my $val = trim($reader->value);
 173             defined $version
 174                 and alert 'Overwriting version', previous => $version, new => $val, line => $reader->lineNumber;
 175             $version = $val;
 176         }
 177         elsif ($name eq 'Data') {
 178             $hash = trim($reader->getAttribute('Hash')) if $reader->hasAttributes;
 179             $reader->read if !$reader->isEmptyElement;
 180             $reader->nodeType == XML_READER_TYPE_TEXT
 181                 or alert 'Expected text node with data', line => $reader->lineNumber;
 182             $data = $reader->value;
 183             $data =~ s/\s+//g if defined $data;
 184         }
 185     }
 186
 187     return if !defined $version || !defined $data;
 188
 189     if ($version =~ /^1\.0/ && $data =~ /^[A-Za-z0-9+\/=]+$/) {
 190         $$out = eval { decode_b64($data) };
 191         if (my $err = $@) {
 192             throw 'Failed to decode key in key file', version => $version, data => $data, error => $err;
 193         }
 194         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         $$out = pack('H*', $data);
 198         $hash = pack('H*', $hash);
 199         my $got_hash = digest_data('SHA256', $$out);
 200         $hash eq substr($got_hash, 0, length($hash))
 201             or throw 'Checksum mismatch', got => $got_hash, expected => $hash;
 202         return (KEY_FILE_TYPE_XML, $version);
 203     }
 204
 205     throw 'Unexpected data in key file', version => $version, data => $data;
 206 }
 207
 208 sub _save_xml {
 209     my $self    = shift;
 210     my $fh      = shift;
 211     my $raw_key = shift;
 212     my $version = shift // 2;
 213
 214     my @cleanup;
 215
 216     my $dom = XML::LibXML::Document->new('1.0', 'UTF-8');
 217     my $doc = XML::LibXML::Element->new('KeyFile');
 218     $dom->setDocumentElement($doc);
 219     my $meta_node = XML::LibXML::Element->new('Meta');
 220     $doc->appendChild($meta_node);
 221     my $version_node = XML::LibXML::Element->new('Version');
 222     $version_node->appendText(sprintf('%.1f', $version));
 223     $meta_node->appendChild($version_node);
 224     my $key_node = XML::LibXML::Element->new('Key');
 225     $doc->appendChild($key_node);
 226     my $data_node = XML::LibXML::Element->new('Data');
 227     $key_node->appendChild($data_node);
 228
 229     if (int($version) == 1) {
 230         my $b64 = encode_b64($raw_key);
 231         push @cleanup, erase_scoped $b64;
 232         $data_node->appendText($b64);
 233     }
 234     elsif (int($version) == 2) {
 235         my @hex = unpack('(H8)8', $raw_key);
 236         my $hex = uc(sprintf("\n      %s\n      %s\n    ", join(' ', @hex[0..3]), join(' ', @hex[4..7])));
 237         push @cleanup, erase_scoped $hex, @hex;
 238         $data_node->appendText($hex);
 239         my $hash = digest_data('SHA256', $raw_key);
 240         substr($hash, 4) = '';
 241         $hash = uc(unpack('H*', $hash));
 242         $data_node->setAttribute('Hash', $hash);
 243     }
 244     else {
 245         throw 'Failed to save unsupported key file version', version => $version;
 246     }
 247
 248     $dom->toFH($fh, 1);
 249 }
 250
 251 1;
 252
 253 __END__
 254
 255 =pod
 256
 257 =encoding UTF-8
 258
 259 =head1 NAME
 260
 261 File::KDBX::Key::File - A file key
 262
 263 =head1 VERSION
 264
 265 version 0.901
 266
 267 =head1 SYNOPSIS
 268
 269     use File::KDBX::Constants qw(:key_file);
 270     use File::KDBX::Key::File;
 271
 272     ### Create a key file:
 273
 274     my $key = File::KDBX::Key::File->new(
 275         filepath    => 'path/to/file.keyx',
 276         type        => KEY_FILE_TYPE_XML,   # optional
 277         version     => 2,                   # optional
 278         raw_key     => $raw_key,            # optional - leave undefined to generate a random key
 279     );
 280     $key->save;
 281
 282     ### Use a key file:
 283
 284     my $key2 = File::KDBX::Key::File->new('path/to/file.keyx');
 285     # OR
 286     my $key2 = File::KDBX::Key::File->new(\$secret);
 287     # OR
 288     my $key2 = File::KDBX::Key::File->new($fh); # or *IO
 289
 290 =head1 DESCRIPTION
 291
 292 A file key (or "key file") is the type of key where the secret is a file. The secret is either the file
 293 contents or is generated based on the file contents. In order to lock and unlock a KDBX database with a key
 294 file, the same file must be presented. The database cannot be opened without the file.
 295
 296 Inherets methods and attributes from L<File::KDBX::Key>.
 297
 298 There are multiple types of key files supported. See L</type>. This module can read and write key files.
 299
 300 =head1 ATTRIBUTES
 301
 302 =head2 type
 303
 304     $type = $key->type;
 305
 306 Get the type of key file. Can be one of from L<File::KDBX::Constants/":key_file">:
 307
 308 =over 4
 309
 310 =item *
 311
 312 C<KEY_FILE_TYPE_BINARY>
 313
 314 =item *
 315
 316 C<KEY_FILE_TYPE_HEX>
 317
 318 =item *
 319
 320 C<KEY_FILE_TYPE_XML>
 321
 322 =item *
 323
 324 C<KEY_FILE_TYPE_HASHED>
 325
 326 =back
 327
 328 =head2 version
 329
 330     $version = $key->version;
 331
 332 Get the file version. Only applies to XML key files.
 333
 334 =head2 filepath
 335
 336     $filepath = $key->filepath;
 337
 338 Get the filepath to the key file, if known.
 339
 340 =head1 METHODS
 341
 342 =head2 load
 343
 344     $key = $key->load($filepath);
 345     $key = $key->load(\$string);
 346     $key = $key->load($fh);
 347     $key = $key->load(*IO);
 348
 349 Load a key file.
 350
 351 =head2 reload
 352
 353     $key->reload;
 354
 355 Re-read the key file, if possible, and update the raw key if the key changed.
 356
 357 =head2 save
 358
 359     $key->save;
 360     $key->save(%options);
 361
 362 Write a key file. Available options:
 363
 364 =over 4
 365
 366 =item *
 367
 368 C<type> - Type of key file (default: value of L</type>, or C<KEY_FILE_TYPE_XML>)
 369
 370 =item *
 371
 372 C<verson> - Version of key file (default: value of L</version>, or 2)
 373
 374 =item *
 375
 376 C<filepath> - Where to save the file (default: value of L</filepath>)
 377
 378 =item *
 379
 380 C<fh> - IO handle to write to (overrides C<filepath>, one of which must be defined)
 381
 382 =item *
 383
 384 C<raw_key> - Raw key (default: value of L</raw_key>)
 385
 386 =item *
 387
 388 C<atomic> - Write to the filepath atomically (default: true)
 389
 390 =back
 391
 392 =head1 BUGS
 393
 394 Please report any bugs or feature requests on the bugtracker website
 395 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 396
 397 When submitting a bug or request, please include a test-file or a
 398 patch to an existing test-file that illustrates the bug or desired
 399 feature.
 400
 401 =head1 AUTHOR
 402
 403 Charles McGarvey <ccm@cpan.org>
 404
 405 =head1 COPYRIGHT AND LICENSE
 406
 407 This software is copyright (c) 2022 by Charles McGarvey.
 408
 409 This is free software; you can redistribute it and/or modify it under
 410 the same terms as the Perl 5 programming language system itself.
 411
 412 =cut