File Coverage

blib/lib/File/KDBX/Key/Composite.pm

Criterion	Covered	Total	%
statement	59	63	93.6
branch	13	16	81.2
condition	4	8	50.0
subroutine	13	14	92.8
pod	6	6	100.0
total	95	107	88.7

package File::KDBX::Key::Composite;
# ABSTRACT: A composite key made up of component keys

use warnings;
use strict;

use Crypt::Digest qw(digest_data);
use File::KDBX::Error;
use File::KDBX::Util qw(:class :erase);
use Ref::Util qw(is_arrayref);
use Scalar::Util qw(blessed);
use namespace::clean;

extends 'File::KDBX::Key';

our $VERSION = '0.904'; # VERSION

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

    my @primitive = grep { defined } is_arrayref($primitive) ? @$primitive : $primitive;
    @primitive or throw 'Composite key must have at least one component key', count => scalar @primitive;

    my @keys = map { blessed $_ && $_->can('raw_key') ? $_ : File::KDBX::Key->new($_,
        keep_primitive => $self->{keep_primitive}) } @primitive;
    $self->{keys} = \@keys;

    return $self->hide;
}


sub raw_key {
    my $self = shift;
    my $challenge = shift;

    my @keys = @{$self->keys} or throw 'Cannot generate a raw key from an empty composite key';

    my @basic_keys = map { $_->raw_key } grep { !$_->can('challenge') } @keys;
    my $response;
    $response = $self->challenge($challenge, @_) if defined $challenge;
    my $cleanup = erase_scoped \@basic_keys, $response;

    return digest_data('SHA256',
        @basic_keys,
        defined $response ? $response : (),
    );
}


sub keys {
    my $self = shift;
    $self->{keys} = shift if @_;
    return $self->{keys} ||= [];
}


sub challenge {
    my $self = shift;

    my @chalresp_keys = grep { $_->can('challenge') } @{$self->keys} or return '';

    my @responses = map { $_->challenge(@_) } @chalresp_keys;
    my $cleanup = erase_scoped \@responses;

    return digest_data('SHA256', @responses);
}

sub hide {
    my $self = shift;
    $_->hide for @{$self->keys};
    return $self;
}

sub show {
    my $self = shift;
    $_->show for @{$self->keys};
    return $self;
}

1;

__END__