Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Key/Composite.pm

   1 package File::KDBX::Key::Composite;
   2 # ABSTRACT: A composite key made up of component keys
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Digest qw(digest_data);
   8 use File::KDBX::Error;
   9 use File::KDBX::Util qw(:class :erase);
  10 use Ref::Util qw(is_arrayref);
  11 use Scalar::Util qw(blessed);
  12 use namespace::clean;
  13
  14 extends 'File::KDBX::Key';
  15
  16 our $VERSION = '999.999'; # VERSION
  17
  18 sub init {
  19     my $self = shift;
  20     my $primitive = shift // throw 'Missing key primitive';
  21
  22     my @primitive = grep { defined } is_arrayref($primitive) ? @$primitive : $primitive;
  23     @primitive or throw 'Composite key must have at least one component key', count => scalar @primitive;
  24
  25     my @keys = map { blessed $_ && $_->can('raw_key') ? $_ : File::KDBX::Key->new($_,
  26         keep_primitive => $self->{keep_primitive}) } @primitive;
  27     $self->{keys} = \@keys;
  28
  29     return $self->hide;
  30 }
  31
  32 =method raw_key
  33
  34     $raw_key = $key->raw_key;
  35     $raw_key = $key->raw_key($challenge);
  36
  37 Get the raw key from each component key and return a generated composite raw key.
  38
  39 =cut
  40
  41 sub raw_key {
  42     my $self = shift;
  43     my $challenge = shift;
  44
  45     my @keys = @{$self->keys} or throw 'Cannot generate a raw key from an empty composite key';
  46
  47     my @basic_keys = map { $_->raw_key } grep { !$_->can('challenge') } @keys;
  48     my $response;
  49     $response = $self->challenge($challenge, @_) if defined $challenge;
  50     my $cleanup = erase_scoped \@basic_keys, $response;
  51
  52     return digest_data('SHA256',
  53         @basic_keys,
  54         defined $response ? $response : (),
  55     );
  56 }
  57
  58 =attr keys
  59
  60     \@keys = $key->keys;
  61
  62 Get one or more component L<File::KDBX::Key>.
  63
  64 =cut
  65
  66 sub keys {
  67     my $self = shift;
  68     $self->{keys} = shift if @_;
  69     return $self->{keys} ||= [];
  70 }
  71
  72 =method challenge
  73
  74     $response = $key->challenge(...);
  75
  76 Issues a challenge to any L<File::KDBX::Key::ChallengeResponse> components keys. Arguments are passed through
  77 to each component key. The responses are hashed together and the composite response is returned.
  78
  79 Returns empty string if there are no challenge-response components keys.
  80
  81 =cut
  82
  83 sub challenge {
  84     my $self = shift;
  85
  86     my @chalresp_keys = grep { $_->can('challenge') } @{$self->keys} or return '';
  87
  88     my @responses = map { $_->challenge(@_) } @chalresp_keys;
  89     my $cleanup = erase_scoped \@responses;
  90
  91     return digest_data('SHA256', @responses);
  92 }
  93
  94 sub hide {
  95     my $self = shift;
  96     $_->hide for @{$self->keys};
  97     return $self;
  98 }
  99
 100 sub show {
 101     my $self = shift;
 102     $_->show for @{$self->keys};
 103     return $self;
 104 }
 105
 106 1;
 107 __END__
 108
 109 =head1 SYNOPSIS
 110
 111     use File::KDBX::Key::Composite;
 112
 113     my $key = File::KDBX::Key::Composite->(\@component_keys);
 114
 115 =head1 DESCRIPTION
 116
 117 A composite key is a collection of other keys. A master key capable of unlocking a KDBX database is always
 118 a composite key, even if it only has a single component.
 119
 120 Inherets methods and attributes from L<File::KDBX::Key>.
 121
 122 =cut