File Coverage

File:Dpkg/OpenPGP/Backend/Sequoia.pm
Coverage:81.2%

linestmtbrancondsubpodtimecode
1# Copyright © 2021-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
16package Dpkg::OpenPGP::Backend::Sequoia;
17
18
23
23
23
69
69
460
use strict;
19
23
23
23
46
0
1219
use warnings;
20
21our $VERSION = '0.01';
22
23
23
23
23
69
0
207
use POSIX qw(:sys_wait_h);
24
25
23
23
23
4209
0
1242
use Dpkg::ErrorHandling;
26
23
23
23
92
23
552
use Dpkg::IPC;
27
23
23
23
92
23
1012
use Dpkg::OpenPGP::ErrorCodes;
28
29
23
23
23
46
0
184
use parent qw(Dpkg::OpenPGP::Backend);
30
31sub DEFAULT_CMD {
32
23
0
23
    return [ qw(sq) ];
33}
34
35sub _sq_exec
36{
37
198
662
    my ($self, @exec) = @_;
38
39
198
227
    my ($stdout, $stderr);
40
198
1205
    spawn(exec => [ $self->{cmd}, @exec ],
41          wait_child => 1, nocheck => 1, timeout => 10,
42          to_string => \$stdout, error_to_string => \$stderr);
43
187
3547
    if (WIFEXITED($?)) {
44
187
603
        my $status = WEXITSTATUS($?);
45
187
0
712
0
        print { *STDERR } "$stdout$stderr" if $status;
46
187
1114
        return $status;
47    } else {
48
0
0
        subprocerr("$self->{cmd} @exec");
49    }
50}
51
52sub armor
53{
54
63
0
432
    my ($self, $type, $in, $out) = @_;
55
56
63
236
    return OPENPGP_MISSING_CMD unless $self->{cmd};
57
58    # We ignore the $type, and let "sq" handle this automatically.
59
63
712
    my $rc = $self->_sq_exec(qw(armor --output), $out, $in);
60
60
584
    return OPENPGP_BAD_DATA if $rc;
61
60
2001
    return OPENPGP_OK;
62}
63
64sub dearmor
65{
66
42
0
80
    my ($self, $type, $in, $out) = @_;
67
68
42
99
    return OPENPGP_MISSING_CMD unless $self->{cmd};
69
70    # We ignore the $type, and let "sq" handle this automatically.
71
42
99
    my $rc = $self->_sq_exec(qw(dearmor --output), $out, $in);
72
40
124
    return OPENPGP_BAD_DATA if $rc;
73
40
1946
    return OPENPGP_OK;
74}
75
76sub inline_verify
77{
78
48
0
168
    my ($self, $inlinesigned, $data, @certs) = @_;
79
80
48
146
    return OPENPGP_MISSING_CMD unless $self->{cmd};
81
82
48
101
    my @opts;
83
48
48
66
225
    push @opts, map { ('--signer-cert', $_) } @certs;
84
48
84
    push @opts, '--output', $data if defined $data;
85
86
48
166
    my $rc = $self->_sq_exec(qw(verify), @opts, $inlinesigned);
87
45
220
    return OPENPGP_NO_SIG if $rc;
88
45
1070
    return OPENPGP_OK;
89}
90
91sub verify
92{
93
31
0
142
    my ($self, $data, $sig, @certs) = @_;
94
95
31
110
    return OPENPGP_MISSING_CMD unless $self->{cmd};
96
97
31
94
    my @opts;
98
31
31
62
78
    push @opts, map { ('--signer-cert', $_) } @certs;
99
31
31
    push @opts, '--detached', $sig;
100
101
31
94
    my $rc = $self->_sq_exec(qw(verify), @opts, $data);
102
29
119
    return OPENPGP_NO_SIG if $rc;
103
29
624
    return OPENPGP_OK;
104}
105
106sub inline_sign
107{
108
14
0
84
    my ($self, $data, $inlinesigned, $key) = @_;
109
110
14
56
    return OPENPGP_MISSING_CMD unless $self->{cmd};
111
14
42
    return OPENPGP_NEEDS_KEYSTORE if $key->needs_keystore();
112
113
14
42
    my @opts;
114
14
56
    push @opts, '--cleartext-signature';
115
14
28
    push @opts, '--signer-key', $key->handle;
116
14
28
    push @opts, '--output', $inlinesigned;
117
118
14
56
    my $rc = $self->_sq_exec('sign', @opts, $data);
119
13
104
    return OPENPGP_KEY_CANNOT_SIGN if $rc;
120
13
299
    return OPENPGP_OK;
121}
122
1231;