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