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 * C<atomic> - Write to the filepath atomically (default: true)
 144
 145 =cut
 146
 147 sub save {
 148     my $self = shift;
 149     my %args = @_;
 150
 151     my @cleanup;
 152     my $raw_key = $args{raw_key} // $self->raw_key // random_bytes(32);
 153     push @cleanup, erase_scoped $raw_key;
 154     length($raw_key) == 32 or throw 'Raw key must be exactly 256 bits (32 bytes)', length => length($raw_key);
 155
 156     my $type        = $args{type} // $self->type // KEY_FILE_TYPE_XML;
 157     my $version     = $args{version} // $self->version // 2;
 158     my $filepath    = $args{filepath} // $self->filepath;
 159     my $fh          = $args{fh};
 160     my $atomic      = $args{atomic} // 1;
 161
 162     my $filepath_temp;
 163     if (!openhandle($fh)) {
 164         $filepath or throw 'Must specify where to safe the key file to';
 165
 166         if ($atomic) {
 167             require File::Temp;
 168             ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", UNLINK => 1) };
 169             if (!$fh or my $err = $@) {
 170                 $err //= 'Unknown error';
 171                 throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
 172                     error       => $err,
 173                     filepath    => $filepath_temp;
 174             }
 175         }
 176         else {
 177             open($fh, '>:raw', $filepath) or throw "Open file failed ($filepath): $!", filepath => $filepath;
 178         }
 179     }
 180
 181     if ($type == KEY_FILE_TYPE_XML) {
 182         $self->_save_xml($fh, $raw_key, $version);
 183     }
 184     elsif ($type == KEY_FILE_TYPE_BINARY) {
 185         print $fh $raw_key;
 186     }
 187     elsif ($type == KEY_FILE_TYPE_HEX) {
 188         my $hex = uc(unpack('H*', $raw_key));
 189         push @cleanup, erase_scoped $hex;
 190         print $fh $hex;
 191     }
 192     else {
 193         throw "Cannot save $type key file (invalid type)", type => $type;
 194     }
 195
 196     close($fh);
 197
 198     if ($filepath_temp) {
 199         my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
 200
 201         my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
 202         my $uid  = $args{uid}  // $file_uid  // -1;
 203         my $gid  = $args{gid}  // $file_gid  // -1;
 204         chmod($mode, $filepath_temp) if defined $mode;
 205         chown($uid, $gid, $filepath_temp);
 206         rename($filepath_temp, $filepath)
 207             or throw "Failed to write file ($filepath): $!", filepath => $filepath;
 208     }
 209 }
 210
 211 ##############################################################################
 212
 213 sub _load_xml {
 214     my $self = shift;
 215     my $buf  = shift;
 216     my $out  = shift;
 217
 218     my ($version, $hash, $data);
 219
 220     my $reader  = XML::LibXML::Reader->new(string => $$buf);
 221     my $pattern = XML::LibXML::Pattern->new('/KeyFile/Meta/Version|/KeyFile/Key/Data');
 222
 223     while ($reader->nextPatternMatch($pattern) == 1) {
 224         next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
 225         my $name = $reader->localName;
 226         if ($name eq 'Version') {
 227             $reader->read if !$reader->isEmptyElement;
 228             $reader->nodeType == XML_READER_TYPE_TEXT
 229                 or alert 'Expected text node with version', line => $reader->lineNumber;
 230             my $val = trim($reader->value);
 231             defined $version
 232                 and alert 'Overwriting version', previous => $version, new => $val, line => $reader->lineNumber;
 233             $version = $val;
 234         }
 235         elsif ($name eq 'Data') {
 236             $hash = trim($reader->getAttribute('Hash')) if $reader->hasAttributes;
 237             $reader->read if !$reader->isEmptyElement;
 238             $reader->nodeType == XML_READER_TYPE_TEXT
 239                 or alert 'Expected text node with data', line => $reader->lineNumber;
 240             $data = $reader->value;
 241             $data =~ s/\s+//g if defined $data;
 242         }
 243     }
 244
 245     return if !defined $version || !defined $data;
 246
 247     if ($version =~ /^1\.0/ && $data =~ /^[A-Za-z0-9+\/=]+$/) {
 248         $$out = eval { decode_b64($data) };
 249         if (my $err = $@) {
 250             throw 'Failed to decode key in key file', version => $version, data => $data, error => $err;
 251         }
 252         return (KEY_FILE_TYPE_XML, $version);
 253     }
 254     elsif ($version =~ /^2\.0/ && $data =~ /^[A-Fa-f0-9]+$/ && defined $hash && $hash =~ /^[A-Fa-f0-9]+$/) {
 255         $$out = pack('H*', $data);
 256         $hash = pack('H*', $hash);
 257         my $got_hash = digest_data('SHA256', $$out);
 258         $hash eq substr($got_hash, 0, length($hash))
 259             or throw 'Checksum mismatch', got => $got_hash, expected => $hash;
 260         return (KEY_FILE_TYPE_XML, $version);
 261     }
 262
 263     throw 'Unexpected data in key file', version => $version, data => $data;
 264 }
 265
 266 sub _save_xml {
 267     my $self    = shift;
 268     my $fh      = shift;
 269     my $raw_key = shift;
 270     my $version = shift // 2;
 271
 272     my @cleanup;
 273
 274     my $dom = XML::LibXML::Document->new('1.0', 'UTF-8');
 275     my $doc = XML::LibXML::Element->new('KeyFile');
 276     $dom->setDocumentElement($doc);
 277     my $meta_node = XML::LibXML::Element->new('Meta');
 278     $doc->appendChild($meta_node);
 279     my $version_node = XML::LibXML::Element->new('Version');
 280     $version_node->appendText(sprintf('%.1f', $version));
 281     $meta_node->appendChild($version_node);
 282     my $key_node = XML::LibXML::Element->new('Key');
 283     $doc->appendChild($key_node);
 284     my $data_node = XML::LibXML::Element->new('Data');
 285     $key_node->appendChild($data_node);
 286
 287     if (int($version) == 1) {
 288         my $b64 = encode_b64($raw_key);
 289         push @cleanup, erase_scoped $b64;
 290         $data_node->appendText($b64);
 291     }
 292     elsif (int($version) == 2) {
 293         my @hex = unpack('(H8)8', $raw_key);
 294         my $hex = uc(sprintf("\n      %s\n      %s\n    ", join(' ', @hex[0..3]), join(' ', @hex[4..7])));
 295         push @cleanup, erase_scoped $hex, @hex;
 296         $data_node->appendText($hex);
 297         my $hash = digest_data('SHA256', $raw_key);
 298         substr($hash, 4) = '';
 299         $hash = uc(unpack('H*', $hash));
 300         $data_node->setAttribute('Hash', $hash);
 301     }
 302     else {
 303         throw 'Failed to save unsupported key file version', version => $version;
 304     }
 305
 306     $dom->toFH($fh, 1);
 307 }
 308
 309 1;
 310 __END__
 311
 312 =head1 SYNOPSIS
 313
 314     use File::KDBX::Constants qw(:key_file);
 315     use File::KDBX::Key::File;
 316
 317     ### Create a key file:
 318
 319     my $key = File::KDBX::Key::File->new(
 320         filepath    => 'path/to/file.keyx',
 321         type        => KEY_FILE_TYPE_XML,   # optional
 322         version     => 2,                   # optional
 323         raw_key     => $raw_key,            # optional - leave undefined to generate a random key
 324     );
 325     $key->save;
 326
 327     ### Use a key file:
 328
 329     my $key2 = File::KDBX::Key::File->new('path/to/file.keyx');
 330     # OR
 331     my $key2 = File::KDBX::Key::File->new(\$secret);
 332     # OR
 333     my $key2 = File::KDBX::Key::File->new($fh); # or *IO
 334
 335 =head1 DESCRIPTION
 336
 337 A file key (or "key file") is the type of key where the secret is a file. The secret is either the file
 338 contents or is generated based on the file contents. In order to lock and unlock a KDBX database with a key
 339 file, the same file must be presented. The database cannot be opened without the file.
 340
 341 Inherets methods and attributes from L<File::KDBX::Key>.
 342
 343 There are multiple types of key files supported. See L</type>. This module can read and write key files.
 344
 345 =cut