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(: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 use parent 'File::KDBX::Key';
  19
  20 our $VERSION = '999.999'; # VERSION
  21
  22 =method load
  23
  24     $key = $key->load($filepath);
  25     $key = $key->load(\$string);
  26     $key = $key->load($fh);
  27     $key = $key->load(*IO);
  28
  29 Load a key file.
  30
  31 =cut
  32
  33 sub init { shift->load(@_) }
  34
  35 sub load {
  36     my $self = shift;
  37     my $primitive = shift // throw 'Missing key primitive';
  38
  39     my $data;
  40     my $cleanup;
  41
  42     if (openhandle($primitive)) {
  43         seek $primitive, 0, 0;  # not using ->seek method so it works on perl 5.10
  44         my $buf = do { local $/; <$primitive> };
  45         $data = \$buf;
  46         $cleanup = erase_scoped $data;
  47     }
  48     elsif (is_scalarref($primitive)) {
  49         $data = $primitive;
  50     }
  51     elsif (defined $primitive && !is_ref($primitive)) {
  52         open(my $fh, '<:raw', $primitive)
  53             or throw "Failed to open key file ($primitive)", filepath => $primitive;
  54         my $buf = do { local $/; <$fh> };
  55         $data = \$buf;
  56         $cleanup = erase_scoped $data;
  57         $self->{filepath} = $primitive;
  58     }
  59     else {
  60         throw 'Unexpected primitive type', type => ref $primitive;
  61     }
  62
  63     my $raw_key;
  64     if (substr($$data, 0, 120) =~ /<KeyFile>/
  65             and my ($type, $version) = $self->_load_xml($data, \$raw_key)) {
  66         $self->{type}    = $type;
  67         $self->{version} = $version;
  68         $self->_set_raw_key($raw_key);
  69     }
  70     elsif (length($$data) == 32) {
  71         $self->{type} = KEY_FILE_TYPE_BINARY;
  72         $self->_set_raw_key($$data);
  73     }
  74     elsif ($$data =~ /^[A-Fa-f0-9]{64}$/) {
  75         $self->{type} = KEY_FILE_TYPE_HEX;
  76         $self->_set_raw_key(pack('H64', $$data));
  77     }
  78     else {
  79         $self->{type} = KEY_FILE_TYPE_HASHED;
  80         $self->_set_raw_key(digest_data('SHA256', $$data));
  81     }
  82
  83     return $self->hide;
  84 }
  85
  86 =method reload
  87
  88     $key->reload;
  89
  90 Re-read the key file, if possible, and update the raw key if the key changed.
  91
  92 =cut
  93
  94 sub reload {
  95     my $self = shift;
  96     $self->init($self->{filepath}) if defined $self->{filepath};
  97     return $self;
  98 }
  99
 100 =attr type
 101
 102     $type = $key->type;
 103
 104 Get the type of key file. Can be one of:
 105
 106 =for :list
 107 * C<KEY_FILE_TYPE_BINARY>
 108 * C<KEY_FILE_TYPE_HEX>
 109 * C<KEY_FILE_TYPE_XML>
 110 * C<KEY_FILE_TYPE_HASHED>
 111
 112 =cut
 113
 114 sub type { $_[0]->{type} }
 115
 116 =attr version
 117
 118     $version = $key->version;
 119
 120 Get the file version. Only applies to XML key files.
 121
 122 =cut
 123
 124 sub version { $_[0]->{version} }
 125
 126 =attr filepath
 127
 128     $filepath = $key->filepath;
 129
 130 Get the filepath to the key file, if known.
 131
 132 =cut
 133
 134 sub filepath { $_[0]->{filepath} }
 135
 136 =method save
 137
 138     $key->save;
 139     $key->save(%options);
 140
 141 Write a key file. Available options:
 142
 143 =for :list
 144 * C<type> - Type of key file (default: value of L</type>, or C<KEY_FILE_TYPE_XML>)
 145 * C<verson> - Version of key file (default: value of L</version>, or 2)
 146 * C<filepath> - Where to save the file (default: value of L</filepath>)
 147 * C<fh> - IO handle to write to (overrides C<filepath>, one of which must be defined)
 148 * C<raw_key> - Raw key (default: value of L</raw_key>)
 149
 150 =cut
 151
 152 sub save {
 153     my $self = shift;
 154     my %args = @_;
 155
 156     my @cleanup;
 157     my $raw_key = $args{raw_key} // $self->raw_key // random_bytes(32);
 158     push @cleanup, erase_scoped $raw_key;
 159     length($raw_key) == 32 or throw 'Raw key must be exactly 256 bits (32 bytes)', length => length($raw_key);
 160
 161     my $type        = $args{type} // $self->type // KEY_FILE_TYPE_XML;
 162     my $version     = $args{version} // $self->version // 2;
 163     my $filepath    = $args{filepath} // $self->filepath;
 164     my $fh          = $args{fh};
 165
 166     my $filepath_temp;
 167     if (!openhandle($fh)) {
 168         $filepath or throw 'Must specify where to safe the key file to';
 169
 170         require File::Temp;
 171         ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) };
 172         if (!$fh or my $err = $@) {
 173             $err //= 'Unknown error';
 174             throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
 175                 error       => $err,
 176                 filepath    => $filepath_temp;
 177         }
 178     }
 179
 180     if ($type == KEY_FILE_TYPE_XML) {
 181         $self->_save_xml($fh, $raw_key, $version);
 182     }
 183     elsif ($type == KEY_FILE_TYPE_BINARY) {
 184         print $fh $raw_key;
 185     }
 186     elsif ($type == KEY_FILE_TYPE_HEX) {
 187         my $hex = uc(unpack('H*', $raw_key));
 188         push @cleanup, erase_scoped $hex;
 189         print $fh $hex;
 190     }
 191     else {
 192         throw "Cannot save $type key file (invalid type)", type => $type;
 193     }
 194
 195     close($fh);
 196
 197     if ($filepath_temp) {
 198         my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
 199
 200         my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
 201         my $uid  = $args{uid}  // $file_uid  // -1;
 202         my $gid  = $args{gid}  // $file_gid  // -1;
 203         chmod($mode, $filepath_temp) if defined $mode;
 204         chown($uid, $gid, $filepath_temp);
 205         rename($filepath_temp, $filepath)
 206             or throw "Failed to write file ($filepath): $!", filepath => $filepath;
 207     }
 208 }
 209
 210 ##############################################################################
 211
 212 sub _load_xml {
 213     my $self = shift;
 214     my $buf  = shift;
 215     my $out  = shift;
 216
 217     my ($version, $hash, $data);
 218
 219     my $reader  = XML::LibXML::Reader->new(string => $$buf);
 220     my $pattern = XML::LibXML::Pattern->new('/KeyFile/Meta/Version|/KeyFile/Key/Data');
 221
 222     while ($reader->nextPatternMatch($pattern) == 1) {
 223         next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
 224         my $name = $reader->localName;
 225         if ($name eq 'Version') {
 226             $reader->read if !$reader->isEmptyElement;
 227             $reader->nodeType == XML_READER_TYPE_TEXT
 228                 or alert 'Expected text node with version', line => $reader->lineNumber;
 229             my $val = trim($reader->value);
 230             defined $version
 231                 and alert 'Overwriting version', previous => $version, new => $val, line => $reader->lineNumber;
 232             $version = $val;
 233         }
 234         elsif ($name eq 'Data') {
 235             $hash = trim($reader->getAttribute('Hash')) if $reader->hasAttributes;
 236             $reader->read if !$reader->isEmptyElement;
 237             $reader->nodeType == XML_READER_TYPE_TEXT
 238                 or alert 'Expected text node with data', line => $reader->lineNumber;
 239             $data = $reader->value;
 240             $data =~ s/\s+//g if defined $data;
 241         }
 242     }
 243
 244     return if !defined $version || !defined $data;
 245
 246     if ($version =~ /^1\.0/ && $data =~ /^[A-Za-z0-9+\/=]+$/) {
 247         $$out = eval { decode_b64($data) };
 248         if (my $err = $@) {
 249             throw 'Failed to decode key in key file', version => $version, data => $data, error => $err;
 250         }
 251         return (KEY_FILE_TYPE_XML, $version);
 252     }
 253     elsif ($version =~ /^2\.0/ && $data =~ /^[A-Fa-f0-9]+$/ && defined $hash && $hash =~ /^[A-Fa-f0-9]+$/) {
 254         $$out = pack('H*', $data);
 255         $hash = pack('H*', $hash);
 256         my $got_hash = digest_data('SHA256', $$out);
 257         $hash eq substr($got_hash, 0, length($hash))
 258             or throw 'Checksum mismatch', got => $got_hash, expected => $hash;
 259         return (KEY_FILE_TYPE_XML, $version);
 260     }
 261
 262     throw 'Unexpected data in key file', version => $version, data => $data;
 263 }
 264
 265 sub _save_xml {
 266     my $self    = shift;
 267     my $fh      = shift;
 268     my $raw_key = shift;
 269     my $version = shift // 2;
 270
 271     my @cleanup;
 272
 273     my $dom = XML::LibXML::Document->new('1.0', 'UTF-8');
 274     my $doc = XML::LibXML::Element->new('KeyFile');
 275     $dom->setDocumentElement($doc);
 276     my $meta_node = XML::LibXML::Element->new('Meta');
 277     $doc->appendChild($meta_node);
 278     my $version_node = XML::LibXML::Element->new('Version');
 279     $version_node->appendText(sprintf('%.1f', $version));
 280     $meta_node->appendChild($version_node);
 281     my $key_node = XML::LibXML::Element->new('Key');
 282     $doc->appendChild($key_node);
 283     my $data_node = XML::LibXML::Element->new('Data');
 284     $key_node->appendChild($data_node);
 285
 286     if (int($version) == 1) {
 287         my $b64 = encode_b64($raw_key);
 288         push @cleanup, erase_scoped $b64;
 289         $data_node->appendText($b64);
 290     }
 291     elsif (int($version) == 2) {
 292         my @hex = unpack('(H8)8', $raw_key);
 293         my $hex = uc(sprintf("\n      %s\n      %s\n    ", join(' ', @hex[0..3]), join(' ', @hex[4..7])));
 294         push @cleanup, erase_scoped $hex, @hex;
 295         $data_node->appendText($hex);
 296         my $hash = digest_data('SHA256', $raw_key);
 297         substr($hash, 4) = '';
 298         $hash = uc(unpack('H*', $hash));
 299         $data_node->setAttribute('Hash', $hash);
 300     }
 301     else {
 302         throw 'Failed to save unsupported key file version', version => $version;
 303     }
 304
 305     $dom->toFH($fh, 1);
 306 }
 307
 308 1;
 309 __END__
 310
 311 =head1 SYNOPSIS
 312
 313     use File::KDBX::Constants qw(:key_file);
 314     use File::KDBX::Key::File;
 315
 316     ### Create a key file:
 317
 318     my $key = File::KDBX::Key::File->new(
 319         filepath    => 'path/to/file.keyx',
 320         type        => KEY_FILE_TYPE_XML,   # optional
 321         version     => 2,                   # optional
 322         raw_key     => $raw_key,            # optional - leave undefined to generate a random key
 323     );
 324     $key->save;
 325
 326     ### Use a key file:
 327
 328     my $key2 = File::KDBX::Key::File->new('path/to/file.keyx');
 329     # OR
 330     my $key2 = File::KDBX::Key::File->new(\$secret);
 331     # OR
 332     my $key2 = File::KDBX::Key::File->new($fh); # or *IO
 333
 334 =head1 DESCRIPTION
 335
 336 A file key (or "key file") is the type of key where the secret is a file. The secret is either the file
 337 contents or is generated based on the file contents. In order to lock and unlock a KDBX database with a key
 338 file, the same file must be presented. The database cannot be opened without the file.
 339
 340 Inherets methods and attributes from L<File::KDBX::Key>.
 341
 342 There are multiple types of key files supported. See L</type>. This module can read and write key files.
 343
 344 =cut