File Coverage

File:Dpkg/OpenPGP/KeyHandle.pm
Coverage:84.3%

linestmtbrancondsubpodtimecode
1# Copyright © 2022 Guillem Jover <guillem@debian.org>
2#
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 2 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program.  If not, see <https://www.gnu.org/licenses/>.
15
16=encoding utf8
17
18 - 29
=head1 NAME

Dpkg::OpenPGP::KeyHandle - OpenPGP key handle support

=head1 DESCRIPTION

This module provides a class to hold an OpenPGP key handle, as a way for
the code to refer to a key in an independent way.

B<Note>: This is a private module, its API can change at any time.

=cut
30
31package Dpkg::OpenPGP::KeyHandle 0.01;
32
33
210
210
210
571
212
3103
use strict;
34
210
210
210
356
140
5210
use warnings;
35
36
210
210
210
634
141
6986
use Carp;
37
210
210
210
365
221
56769
use List::Util qw(any none);
38
39sub new {
40
600
0
4299
    my ($this, %opts) = @_;
41
600
4264
    my $class = ref($this) || $this;
42
43    my $self = {
44        type => $opts{type} // 'auto',
45        handle => $opts{handle},
46
600
2017
    };
47
600
1207
    bless $self, $class;
48
49
600
1665
    $self->_sanitize();
50
51
600
1411
    return $self;
52}
53
54my $keyid_regex = qr/^(?:0x)?([[:xdigit:]]+)$/;
55
56sub _sanitize {
57
858
1727
    my ($self) = shift;
58
59
858
2265
    my $type = $self->{type};
60
858
2308
    if ($type eq 'auto') {
61
15
119
        if (-e $self->{handle}) {
62
0
0
            $type = 'keyfile';
63        } else {
64
15
16
            $type = 'autoid';
65        }
66    }
67
68
858
2681
    if ($type eq 'autoid') {
69
15
63
        if ($self->{handle} =~ m/$keyid_regex/) {
70
9
13
            $self->{handle} = $1;
71
9
10
            $type = 'keyid';
72        } else {
73
6
6
            $type = 'userid';
74        }
75
15
12
        $self->{type} = $type;
76    } elsif ($type eq 'keyid') {
77
9
36
        if ($self->{handle} =~ m/$keyid_regex/) {
78
9
14
            $self->{handle} = $1;
79        }
80    }
81
82
858
2790
8519
3496
    if (none { $type eq $_ } qw(userid keyid keyfile keystore)) {
83
0
0
        croak "unknown type parameter value $type";
84    }
85
86
858
2301
    return;
87}
88
89sub needs_keystore {
90
612
0
648
    my $self = shift;
91
92
612
1224
1989
1824
    return any { $self->{type} eq $_ } qw(keyid userid);
93}
94
95sub set {
96
258
0
785
    my ($self, $type, $handle) = @_;
97
98
258
945
    $self->{type} = $type;
99
258
687
    $self->{handle} = $handle;
100
101
258
1534
    $self->_sanitize();
102}
103
104sub type {
105
1464
0
1340
    my $self = shift;
106
107
1464
6446
    return $self->{type};
108}
109
110sub handle {
111
1200
0
1145
    my $self = shift;
112
113
1200
7875
    return $self->{handle};
114}
115
116 - 122
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
123
1241;