view release on metacpan or  search on metacpan

lib/File/KDBX/Key/File.pm  view on Meta::CPAN

package File::KDBX::Key::File;
# ABSTRACT: A file key

use warnings;
use strict;

use Crypt::Digest qw(digest_data);
use Crypt::Misc 0.029 qw(decode_b64 encode_b64);
use Crypt::PRNG qw(random_bytes);
use File::KDBX::Constants qw(:key_file);
use File::KDBX::Error;
use File::KDBX::Util qw(:class :erase trim);
use Ref::Util qw(is_ref is_scalarref);
use Scalar::Util qw(openhandle);
use XML::LibXML::Reader;
use namespace::clean;

extends 'File::KDBX::Key';

our $VERSION = '0.906'; # VERSION


has 'type',     is => 'ro';
has 'version',  is => 'ro';
has 'filepath', is => 'ro';


sub init { shift->load(@_) }

sub load {
    my $self = shift;
    my $primitive = shift // throw 'Missing key primitive';

    my $data;
    my $cleanup;

    if (openhandle($primitive)) {
        seek $primitive, 0, 0;  # not using ->seek method so it works on perl 5.10
        my $buf = do { local $/; <$primitive> };
        $data = \$buf;
        $cleanup = erase_scoped $data;
    }
    elsif (is_scalarref($primitive)) {
        $data = $primitive;
    }
    elsif (defined $primitive && !is_ref($primitive)) {
        open(my $fh, '<:raw', $primitive)
            or throw "Failed to open key file ($primitive)", filepath => $primitive;
        my $buf = do { local $/; <$fh> };
        $data = \$buf;
        $cleanup = erase_scoped $data;
        $self->{filepath} = $primitive;
    }
    else {
        throw 'Unexpected primitive type', type => ref $primitive;
    }

    my $raw_key;
    if (substr($$data, 0, 120) =~ /<KeyFile>/
            and my ($type, $version) = $self->_load_xml($data, \$raw_key)) {
        $self->{type}    = $type;
        $self->{version} = $version;
        $self->_set_raw_key($raw_key);
    }
    elsif (length($$data) == 32) {
        $self->{type} = KEY_FILE_TYPE_BINARY;
        $self->_set_raw_key($$data);
    }
    elsif ($$data =~ /^[A-Fa-f0-9]{64}$/) {
        $self->{type} = KEY_FILE_TYPE_HEX;
        $self->_set_raw_key(pack('H64', $$data));
    }
    else {