| File: | Dpkg/OpenPGP/KeyHandle.pm |
| Coverage: | 84.3% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 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 | |||||||
| 31 | package 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 | |||||||
| 39 | sub 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 | |||||||
| 54 | my $keyid_regex = qr/^(?:0x)?([[:xdigit:]]+)$/; | ||||||
| 55 | |||||||
| 56 | sub _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 | |||||||
| 89 | sub 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 | |||||||
| 95 | sub 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 | |||||||
| 104 | sub type { | ||||||
| 105 | 1464 | 0 | 1340 | my $self = shift; | |||
| 106 | |||||||
| 107 | 1464 | 6446 | return $self->{type}; | ||||
| 108 | } | ||||||
| 109 | |||||||
| 110 | sub 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 | |||||||
| 124 | 1; | ||||||