File: Composite.pm

package info (click to toggle)
libfile-kdbx-perl 0.906-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,052 kB
  • sloc: perl: 10,607; makefile: 2
file content (156 lines) | stat: -rw-r--r-- 3,612 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
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.906'; # 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__

=pod

=encoding UTF-8

=head1 NAME

File::KDBX::Key::Composite - A composite key made up of component keys

=head1 VERSION

version 0.906

=head1 SYNOPSIS

    use File::KDBX::Key::Composite;

    my $key = File::KDBX::Key::Composite->(\@component_keys);

=head1 DESCRIPTION

A composite key is a collection of other keys. A master key capable of unlocking a KDBX database is always
a composite key, even if it only has a single component.

Inherets methods and attributes from L<File::KDBX::Key>.

=head1 ATTRIBUTES

=head2 keys

    \@keys = $key->keys;

Get one or more component L<File::KDBX::Key>.

=head1 METHODS

=head2 raw_key

    $raw_key = $key->raw_key;
    $raw_key = $key->raw_key($challenge);

Get the raw key from each component key and return a generated composite raw key.

=head2 challenge

    $response = $key->challenge(...);

Issues a challenge to any L<File::KDBX::Key::ChallengeResponse> components keys. Arguments are passed through
to each component key. The responses are hashed together and the composite response is returned.

Returns empty string if there are no challenge-response components keys.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
L<https://github.com/chazmcgarvey/File-KDBX/issues>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Charles McGarvey <ccm@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2022 by Charles McGarvey.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut