File Coverage

File:Dpkg/OpenPGP/Backend/GnuPG.pm
Coverage:75.8%

linestmtbrancondsubpodtimecode
1# Copyright © 207, 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::GnuPG;
17
18
30
30
30
30
180
60
780
use strict;
19
30
30
30
30
90
30
2070
use warnings;
20
21our $VERSION = '0.01';
22
23
30
30
30
30
120
30
330
use POSIX qw(:sys_wait_h);
24
30
30
30
30
17190
185760
1350
use File::Temp;
25
30
30
30
30
262440
348510
5790
use MIME::Base64;
26
27
30
30
30
30
450
90
6660
use Dpkg::ErrorHandling;
28
30
30
30
30
270
120
2610
use Dpkg::IPC;
29
30
30
30
30
26640
150
3210
use Dpkg::File;
30
30
30
30
30
300
60
2100
use Dpkg::Path qw(find_command);
31
30
30
30
30
240
60
4590
use Dpkg::OpenPGP::ErrorCodes;
32
33
30
30
30
30
450
90
420
use parent qw(Dpkg::OpenPGP::Backend);
34
35sub DEFAULT_CMDV {
36
30
30
0
210
    return [ qw(gpgv) ];
37}
38
39sub DEFAULT_CMDSTORE {
40
30
30
0
150
    return [ qw(gpg-agent) ];
41}
42
43sub DEFAULT_CMD {
44
30
30
0
180
    return [ qw(gpg) ];
45}
46
47sub has_backend_cmd {
48
52
52
0
130
    my $self = shift;
49
50
52
33
260
    return defined $self->{cmd} && defined $self->{cmdstore};
51}
52
53sub has_keystore {
54
26
26
0
52
    my $self = shift;
55
56
26
50
26
    return 0 if not defined $self->{cmdstore};
57    return 1 if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) ||
58
26
50
14
260
                ($ENV{HOME} && -e "$ENV{HOME}/.gnupg");
59
0
0
    return 0;
60}
61
62sub can_use_key {
63
26
26
0
78
    my ($self, $key) = @_;
64
65    # With gpg, a secret key always requires gpg-agent (the key store).
66
26
78
    return $self->has_keystore();
67}
68
69sub has_verify_cmd {
70
138
138
0
138
    my $self = shift;
71
72
138
33
384
    return defined $self->{cmdv} || defined $self->{cmd};
73}
74
75sub get_trusted_keyrings {
76
0
0
0
0
    my $self = shift;
77
78
0
0
    my @keyrings;
79
0
0
0
0
    if (length $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") {
80
0
0
        push @keyrings, "$ENV{HOME}/.gnupg/trustedkeys.gpg";
81    }
82
0
0
    return @keyrings;
83}
84
85# _pgp_* functions are strictly for applying or removing ASCII armor.
86# See <https://datatracker.ietf.org/doc/html/rfc4880#section-6> for more
87# details.
88#
89# Note that these _pgp_* functions are only necessary while relying on
90# gpgv, and gpgv itself does not verify multiple signatures correctly
91# (see https://bugs.debian.org/1010955).
92
93sub _pgp_dearmor_data {
94
288
288
587
    my ($type, $data) = @_;
95
96    # Note that we ignore an incorrect or absent checksum, following the
97    # guidance of
98    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
99
288
10557
    my $armor_regex = qr{
100        -----BEGIN\ PGP\ \Q$type\E-----[\r\t ]*\n
101        (?:[^:]+:\ [^\n]*[\r\t ]*\n)*
102        [\r\t ]*\n
103        ([a-zA-Z0-9/+\n]+={0,2})[\r\t ]*\n
104        (?:=[a-zA-Z0-9/+]{4}[\r\t ]*\n)?
105        -----END\ PGP\ \Q$type\E-----
106    }xm;
107
108
288
100
4043
    if ($data =~ m/$armor_regex/) {
109
228
2244
        return decode_base64($1);
110    }
111
60
840
    return;
112}
113
114sub _pgp_armor_checksum {
115
90
90
180
    my ($data) = @_;
116
117    # From the upcoming revision to RFC 4880
118    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
119    #
120    # The resulting three-octet-wide value then gets base64-encoded into
121    # four base64 ASCII characters.
122
123
90
90
    my $CRC24_INIT = 0xB704CE;
124
90
120
    my $CRC24_GENERATOR = 0x864CFB;
125
126
90
4350
    my @bytes = unpack 'C*', $data;
127
90
390
    my $crc = $CRC24_INIT;
128
90
180
    for my $b (@bytes) {
129
39840
44310
        $crc ^= ($b << 16);
130
39840
45900
        for (1 .. 8) {
131
318720
313470
            $crc <<= 1;
132
318720
100
430500
            if ($crc & 0x1000000) {
133                # Clear bit 25 to avoid overflow.
134
160050
159630
                $crc &= 0xffffff;
135
160050
180270
                $crc ^= $CRC24_GENERATOR;
136            }
137        }
138    }
139
90
240
    my $sum = pack 'CCC', ($crc >> 16) & 0xff, ($crc >> 8) & 0xff, $crc & 0xff;
140
90
540
    return encode_base64($sum, q{});
141}
142
143sub _pgp_armor_data {
144
90
90
180
    my ($type, $data) = @_;
145
146
90
2670
    my $out = encode_base64($data, q{}) =~ s/(.{1,64})/$1\n/gr;
147
90
390
    chomp $out;
148
90
450
    my $crc = _pgp_armor_checksum($data);
149
90
210
    my $armor = <<~"ARMOR";
150        -----BEGIN PGP $type-----
151
152        $out
153        =$crc
154        -----END PGP $type-----
155        ARMOR
156
90
90
    return $armor;
157}
158
159sub armor {
160
90
90
0
240
    my ($self, $type, $in, $out) = @_;
161
162
90
210
    my $raw_data = file_slurp($in);
163
90
67
210
    my $data = _pgp_dearmor_data($type, $raw_data) // $raw_data;
164
90
180
    my $armor = _pgp_armor_data($type, $data);
165
90
50
120
    return OPENPGP_BAD_DATA unless defined $armor;
166
90
120
    file_dump($out, $armor);
167
168
90
360
    return OPENPGP_OK;
169}
170
171sub dearmor {
172
198
198
0
504
    my ($self, $type, $in, $out) = @_;
173
174
198
592
    my $armor = file_slurp($in);
175
198
426
    my $data = _pgp_dearmor_data($type, $armor);
176
198
50
456
    return OPENPGP_BAD_DATA unless defined $data;
177
198
375
    file_dump($out, $data);
178
179
198
4035
    return OPENPGP_OK;
180}
181
182sub _gpg_exec
183{
184
189
189
573
    my ($self, @exec) = @_;
185
186
189
187
    my ($stdout, $stderr);
187
189
766
    spawn(exec => \@exec, wait_child => 1, nocheck => 1, timeout => 10,
188          to_string => \$stdout, error_to_string => \$stderr);
189
182
50
2032
    if (WIFEXITED($?)) {
190
182
337
        my $status = WEXITSTATUS($?);
191
182
0
50
367
0
        print { *STDERR } "$stdout$stderr" if $status;
192
182
1579
        return $status;
193    } else {
194
0
0
        subprocerr("@exec");
195    }
196}
197
198sub _gpg_options_weak_digests {
199    my @gpg_weak_digests = map {
200
164
328
164
188
518
        (qw(--weak-digest), $_)
201    } qw(SHA1 RIPEMD160);
202
203
164
324
    return @gpg_weak_digests;
204}
205
206sub _gpg_verify {
207
138
138
275
    my ($self, $signeddata, $sig, $data, @certs) = @_;
208
209
138
50
462
    return OPENPGP_MISSING_CMD if ! $self->has_verify_cmd();
210
211
138
972
    my $gpg_home = File::Temp->newdir('dpkg-gpg-verify.XXXXXXXX', TMPDIR => 1);
212
213
138
33298
    my @exec;
214
138
50
276
    if ($self->{cmdv}) {
215
138
191
        push @exec, $self->{cmdv};
216    } else {
217
0
0
        push @exec, $self->{cmd};
218
0
0
        push @exec, qw(--no-options --no-default-keyring --batch --quiet);
219    }
220
138
241
    push @exec, _gpg_options_weak_digests();
221
138
166
    push @exec, '--homedir', $gpg_home;
222
138
352
    foreach my $cert (@certs) {
223
138
383
        my $certring = File::Temp->new(UNLINK => 1, SUFFIX => '.pgp');
224
138
26357
        my $rc = $self->dearmor('PUBLIC KEY BLOCK', $cert, $certring);
225
138
50
162
        $certring = $cert if $rc;
226
138
168
        push @exec, '--keyring', $certring;
227    }
228
138
50
162
    push @exec, '--output', $data if defined $data;
229
138
50
194
    if (! $self->{cmdv}) {
230
0
0
        push @exec, '--verify';
231    }
232
138
100
251
    push @exec, $sig if defined $sig;
233
138
109
    push @exec, $signeddata;
234
235
138
320
    my $rc = $self->_gpg_exec(@exec);
236
133
50
156
    return OPENPGP_NO_SIG if $rc;
237
133
521
    return OPENPGP_OK;
238}
239
240sub inline_verify {
241
83
83
0
131
    my ($self, $inlinesigned, $data, @certs) = @_;
242
243
83
189
    return $self->_gpg_verify($inlinesigned, undef, $data, @certs);
244}
245
246sub verify {
247
55
55
0
195
    my ($self, $data, $sig, @certs) = @_;
248
249
55
166
    return $self->_gpg_verify($data, $sig, undef, @certs);
250}
251
252sub inline_sign {
253
26
26
0
130
    my ($self, $data, $inlinesigned, $key) = @_;
254
255
26
50
104
    return OPENPGP_MISSING_CMD if ! $self->has_backend_cmd();
256
257
26
104
    my @exec = ($self->{cmd});
258
26
104
    push @exec, _gpg_options_weak_digests();
259
26
104
    push @exec, qw(--utf8-strings --textmode --armor);
260
26
50
0
52
    if ($key->type eq 'keyfile') {
261        # Promote the keyfile keyhandle to a keystore, this way we share the
262        # same gpg-agent and can get any password cached.
263
26
182
        my $gpg_home = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
264
265
26
5590
        push @exec, '--homedir', $gpg_home;
266
26
52
        $self->_gpg_exec(@exec, qw(--quiet --no-tty --batch --import), $key->handle);
267
25
950
        $key->set('keystore', $gpg_home);
268    } elsif ($key->type eq 'keystore') {
269
0
0
        push @exec, '--homedir', $key->handle;
270    } else {
271
0
0
        push @exec, '--local-user', $key->handle;
272    }
273
25
325
    push @exec, '--output', $inlinesigned;
274
275
25
125
    my $rc = $self->_gpg_exec(@exec, '--clearsign', $data);
276
24
50
192
    return OPENPGP_KEY_CANNOT_SIGN if $rc;
277
24
552
    return OPENPGP_OK;
278}
279
2801;