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(:erase);
  10 use Ref::Util qw(is_arrayref);
  11 use Scalar::Util qw(blessed);
  12 use namespace::clean;
  13
  14 use parent '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 sub raw_key {
  33     my $self = shift;
  34     my $challenge = shift;
  35
  36     my @keys = @{$self->keys} or throw 'Cannot generate a raw key from an empty composite key';
  37
  38     my @basic_keys = map { $_->raw_key } grep { !$_->can('challenge') } @keys;
  39     my $response;
  40     $response = $self->challenge($challenge, @_) if defined $challenge;
  41     my $cleanup = erase_scoped \@basic_keys, $response;
  42
  43     return digest_data('SHA256',
  44         @basic_keys,
  45         defined $response ? $response : (),
  46     );
  47 }
  48
  49 sub hide {
  50     my $self = shift;
  51     $_->hide for @{$self->keys};
  52     return $self;
  53 }
  54
  55 sub show {
  56     my $self = shift;
  57     $_->show for @{$self->keys};
  58     return $self;
  59 }
  60
  61 sub challenge {
  62     my $self = shift;
  63     my @args = @_;
  64
  65     my @chalresp_keys = grep { $_->can('challenge') } @{$self->keys} or return '';
  66
  67     my @responses = map { $_->challenge(@args) } @chalresp_keys;
  68     my $cleanup = erase_scoped \@responses;
  69
  70     return digest_data('SHA256', @responses);
  71 }
  72
  73 =attr keys
  74
  75     \@keys = $key->keys;
  76
  77 Get one or more component L<File::KDBX::Key>.
  78
  79 =cut
  80
  81 sub keys {
  82     my $self = shift;
  83     $self->{keys} = shift if @_;
  84     return $self->{keys} ||= [];
  85 }
  86
  87 1;