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