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 = '0.904'; # 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
  33 sub raw_key {
  34     my $self = shift;
  35     my $challenge = shift;
  36
  37     my @keys = @{$self->keys} or throw 'Cannot generate a raw key from an empty composite key';
  38
  39     my @basic_keys = map { $_->raw_key } grep { !$_->can('challenge') } @keys;
  40     my $response;
  41     $response = $self->challenge($challenge, @_) if defined $challenge;
  42     my $cleanup = erase_scoped \@basic_keys, $response;
  43
  44     return digest_data('SHA256',
  45         @basic_keys,
  46         defined $response ? $response : (),
  47     );
  48 }
  49
  50
  51 sub keys {
  52     my $self = shift;
  53     $self->{keys} = shift if @_;
  54     return $self->{keys} ||= [];
  55 }
  56
  57
  58 sub challenge {
  59     my $self = shift;
  60
  61     my @chalresp_keys = grep { $_->can('challenge') } @{$self->keys} or return '';
  62
  63     my @responses = map { $_->challenge(@_) } @chalresp_keys;
  64     my $cleanup = erase_scoped \@responses;
  65
  66     return digest_data('SHA256', @responses);
  67 }
  68
  69 sub hide {
  70     my $self = shift;
  71     $_->hide for @{$self->keys};
  72     return $self;
  73 }
  74
  75 sub show {
  76     my $self = shift;
  77     $_->show for @{$self->keys};
  78     return $self;
  79 }
  80
  81 1;
  82
  83 __END__
  84
  85 =pod
  86
  87 =encoding UTF-8
  88
  89 =head1 NAME
  90
  91 File::KDBX::Key::Composite - A composite key made up of component keys
  92
  93 =head1 VERSION
  94
  95 version 0.904
  96
  97 =head1 SYNOPSIS
  98
  99     use File::KDBX::Key::Composite;
 100
 101     my $key = File::KDBX::Key::Composite->(\@component_keys);
 102
 103 =head1 DESCRIPTION
 104
 105 A composite key is a collection of other keys. A master key capable of unlocking a KDBX database is always
 106 a composite key, even if it only has a single component.
 107
 108 Inherets methods and attributes from L<File::KDBX::Key>.
 109
 110 =head1 ATTRIBUTES
 111
 112 =head2 keys
 113
 114     \@keys = $key->keys;
 115
 116 Get one or more component L<File::KDBX::Key>.
 117
 118 =head1 METHODS
 119
 120 =head2 raw_key
 121
 122     $raw_key = $key->raw_key;
 123     $raw_key = $key->raw_key($challenge);
 124
 125 Get the raw key from each component key and return a generated composite raw key.
 126
 127 =head2 challenge
 128
 129     $response = $key->challenge(...);
 130
 131 Issues a challenge to any L<File::KDBX::Key::ChallengeResponse> components keys. Arguments are passed through
 132 to each component key. The responses are hashed together and the composite response is returned.
 133
 134 Returns empty string if there are no challenge-response components keys.
 135
 136 =head1 BUGS
 137
 138 Please report any bugs or feature requests on the bugtracker website
 139 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 140
 141 When submitting a bug or request, please include a test-file or a
 142 patch to an existing test-file that illustrates the bug or desired
 143 feature.
 144
 145 =head1 AUTHOR
 146
 147 Charles McGarvey <ccm@cpan.org>
 148
 149 =head1 COPYRIGHT AND LICENSE
 150
 151 This software is copyright (c) 2022 by Charles McGarvey.
 152
 153 This is free software; you can redistribute it and/or modify it under
 154 the same terms as the Perl 5 programming language system itself.
 155
 156 =cut