File Coverage

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

linestmtbrancondsubpodtimecode
1# Copyright © 2007, 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::Backend::GnuPG - OpenPGP backend for GnuPG

=head1 DESCRIPTION

This module provides a class that implements the OpenPGP backend
for GnuPG.

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

=cut
30
31package Dpkg::OpenPGP::Backend::GnuPG 0.01;
32
33
174
174
174
174
696
348
5220
use strict;
34
174
174
174
174
406
232
11948
use warnings;
35
36
174
174
174
174
754
580
1160
use POSIX qw(:sys_wait_h);
37
174
174
174
174
33176
348
12470
use File::Basename;
38
174
174
174
174
95584
1166670
10846
use File::Temp;
39
174
174
174
174
34800
314592
9860
use File::Copy;
40
174
174
174
174
101848
113854
9280
use MIME::Base64;
41
42
174
174
174
174
696
174
10324
use Dpkg::ErrorHandling;
43
174
174
174
174
406
174
4640
use Dpkg::IPC;
44
174
174
174
174
52838
232
7366
use Dpkg::File;
45
174
174
174
174
754
290
5394
use Dpkg::Path qw(find_command);
46
174
174
174
174
464
232
12354
use Dpkg::OpenPGP::ErrorCodes;
47
48
174
174
174
174
522
116
638
use parent qw(Dpkg::OpenPGP::Backend);
49
50sub DEFAULT_CMDV {
51
312
312
0
1722
    return [ qw(gpgv-sq gpgv) ];
52}
53
54sub DEFAULT_CMDSTORE {
55
312
312
0
1110
    return [ qw(gpg-agent) ];
56}
57
58sub DEFAULT_CMD {
59
312
312
0
1534
    return [ qw(gpg-sq gpg) ];
60}
61
62sub has_backend_cmd {
63
528
528
0
940
    my $self = shift;
64
65
528
33
4340
    return defined $self->{cmd} && defined $self->{cmdstore};
66}
67
68sub has_keystore {
69
264
264
0
514
    my $self = shift;
70
71
264
50
840
    return 0 if not defined $self->{cmdstore};
72    return 1 if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) ||
73
264
50
14
3880
                ($ENV{HOME} && -e "$ENV{HOME}/.gnupg");
74
0
0
    return 0;
75}
76
77sub can_use_key {
78
264
264
0
452
    my ($self, $key) = @_;
79
80    # With gpg, a secret key always requires gpg-agent (the key store).
81
264
966
    return $self->has_keystore();
82}
83
84sub has_verify_cmd {
85
1740
1740
0
2974
    my $self = shift;
86
87
1740
33
10234
    return defined $self->{cmdv} || defined $self->{cmd};
88}
89
90sub get_trusted_keyrings {
91
0
0
0
0
    my $self = shift;
92
93
0
0
    my $keystore;
94
0
0
0
0
0
0
    if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) {
95
0
0
        $keystore = $ENV{GNUPGHOME};
96    } elsif ($ENV{HOME} && -e "$ENV{HOME}/.gnupg") {
97
0
0
        $keystore = "$ENV{HOME}/.gnupg";
98    } else {
99
0
0
        return;
100    }
101
102
0
0
    my @keyrings;
103
0
0
    foreach my $keyring (qw(trustedkeys.kbx trustedkeys.gpg)) {
104
0
0
0
        push @keyrings, "$keystore/$keyring" if -r "$keystore/$keyring";
105    }
106
0
0
    return @keyrings;
107}
108
109# _pgp_* functions are strictly for applying or removing ASCII armor.
110# See <https://datatracker.ietf.org/doc/html/rfc4880#section-6> for more
111# details.
112#
113# Note that these _pgp_* functions are only necessary while relying on
114# gpgv, and gpgv itself does not verify multiple signatures correctly
115# (see https://bugs.debian.org/1010955).
116
117sub _pgp_dearmor_data {
118
1560
1560
3884
    my ($type, $data) = @_;
119
120    # Note that we ignore an incorrect or absent checksum, following the
121    # guidance of
122    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
123
1560
84942
    my $armor_regex = qr{
124        -----BEGIN\ PGP\ \Q$type\E-----[\r\t ]*\n
125        (?:[^:]+:\ [^\n]*[\r\t ]*\n)*
126        [\r\t ]*\n
127        ([a-zA-Z0-9/+\n]+={0,2})[\r\t ]*\n
128        (?:=[a-zA-Z0-9/+]{4}[\r\t ]*\n)?
129        -----END\ PGP\ \Q$type\E-----
130    }xm;
131
132
1560
100
22676
    if ($data =~ m/$armor_regex/) {
133
936
9716
        return decode_base64($1);
134    }
135
624
6604
    return;
136}
137
138sub _pgp_armor_checksum {
139
936
936
1756
    my ($data) = @_;
140
141    # From the upcoming revision to RFC 4880
142    # <https://datatracker.ietf.org/doc/draft-ietf-openpgp-crypto-refresh/>.
143    #
144    # The resulting three-octet-wide value then gets base64-encoded into
145    # four base64 ASCII characters.
146
147
936
1260
    my $CRC24_INIT = 0xB704CE;
148
936
924
    my $CRC24_GENERATOR = 0x864CFB;
149
150
936
25570
    my @bytes = unpack 'C*', $data;
151
936
2844
    my $crc = $CRC24_INIT;
152
936
2024
    for my $b (@bytes) {
153
414336
297262
        $crc ^= ($b << 16);
154
414336
329632
        for (1 .. 8) {
155
3314688
2082484
            $crc <<= 1;
156
3314688
100
3004576
            if ($crc & 0x1000000) {
157                # Clear bit 25 to avoid overflow.
158
1664520
1064520
                $crc &= 0xffffff;
159
1664520
1226678
                $crc ^= $CRC24_GENERATOR;
160            }
161        }
162    }
163
936
7230
    my $sum = pack 'CCC', ($crc >> 16) & 0xff, ($crc >> 8) & 0xff, $crc & 0xff;
164
936
16944
    return encode_base64($sum, q{});
165}
166
167sub _pgp_armor_data {
168
936
936
1780
    my ($type, $data) = @_;
169
170
936
23884
    my $out = encode_base64($data, q{}) =~ s/(.{1,64})/$1\n/gr;
171
936
3848
    chomp $out;
172
936
2044
    my $crc = _pgp_armor_checksum($data);
173
936
5206
    my $armor = <<~"ARMOR";
174        -----BEGIN PGP $type-----
175
176        $out
177        =$crc
178        -----END PGP $type-----
179        ARMOR
180
936
2298
    return $armor;
181}
182
183sub armor {
184
936
936
0
9492
    my ($self, $type, $in, $out) = @_;
185
186
936
2936
    my $raw_data = file_slurp($in);
187
936
67
3318
    my $data = _pgp_dearmor_data($type, $raw_data) // $raw_data;
188
936
2462
    my $armor = _pgp_armor_data($type, $data);
189
936
50
2622
    return OPENPGP_BAD_DATA unless defined $armor;
190
936
3522
    file_dump($out, $armor);
191
192
936
8734
    return OPENPGP_OK;
193}
194
195sub dearmor {
196
624
624
0
1410
    my ($self, $type, $in, $out) = @_;
197
198
624
2046
    my $armor = file_slurp($in);
199
624
1838
    my $data = _pgp_dearmor_data($type, $armor);
200
624
50
1698
    return OPENPGP_BAD_DATA unless defined $data;
201
624
3634
    file_dump($out, $data);
202
203
624
5236
    return OPENPGP_OK;
204}
205
206sub _gpg_exec
207{
208
3348
3348
12556
    my ($self, @exec) = @_;
209
210
3348
4098
    my ($stdout, $stderr);
211
3348
17506
    spawn(exec => \@exec, wait_child => 1, nocheck => 1, timeout => 10,
212          to_string => \$stdout, error_to_string => \$stderr);
213
3276
50
27926
    if (WIFEXITED($?)) {
214
3276
7295
        my $status = WEXITSTATUS($?);
215
3276
0
50
6664
0
        print { *STDERR } "$stdout$stderr" if $status;
216
3276
21190
        return $status;
217    } else {
218
0
0
        subprocerr("@exec");
219    }
220}
221
222sub _gpg_options_weak_digests {
223    my @gpg_weak_digests = map {
224
1692
3384
1692
2550
5424
        (qw(--weak-digest), $_)
225    } qw(SHA1 RIPEMD160);
226
227
1692
3390
    return @gpg_weak_digests;
228}
229
230sub _gpg_verify {
231
1428
1428
3318
    my ($self, $signeddata, $sig, $data, @certs) = @_;
232
233
1428
50
7344
    return OPENPGP_MISSING_CMD if ! $self->has_verify_cmd();
234
235
1428
12188
    my $gpg_home = File::Temp->newdir('dpkg-gpg-verify.XXXXXXXX', TMPDIR => 1);
236
1428
441906
    my @cmd_opts = qw(--no-options --no-default-keyring --batch --quiet);
237
1428
1920
    my @gpg_opts;
238
1428
2832
    push @gpg_opts, _gpg_options_weak_digests();
239
1428
1854
    push @gpg_opts, '--homedir', $gpg_home;
240
1428
2072
    push @cmd_opts, @gpg_opts;
241
242
1428
1326
    my @exec;
243
1428
50
3510
    if ($self->{cmdv}) {
244
1428
2286
        push @exec, $self->{cmdv};
245
1428
2618
        push @exec, @gpg_opts;
246        # We need to touch the trustedkeys.gpg keyring, otherwise gpgv will
247        # emit an error about the trustedkeys.kbx file being of unknown type.
248
1428
8070
        file_touch("$gpg_home/trustedkeys.gpg");
249    } else {
250
0
0
        push @exec, $self->{cmd};
251
0
0
        push @exec, @cmd_opts;
252    }
253
1428
4342
    foreach my $cert (@certs) {
254
1428
6296
        my $certring = File::Temp->new(UNLINK => 1, SUFFIX => '.pgp');
255
1428
338714
        my $rc;
256        # XXX: The internal dearmor() does not handle concatenated ASCII Armor,
257        # but the old implementation handled such certificate keyrings, so to
258        # avoid regressing for now, we fallback to use the GnuPG dearmor.
259
1428
50
50
5078
        if ($cert =~ m{\.kbx$}) {
260            # Accept GnuPG apparent keybox-format keyrings as-is.
261
0
0
            $rc = 1;
262        } elsif (defined $self->{cmd}) {
263
1428
4318
            $rc = $self->_gpg_exec($self->{cmd}, @cmd_opts, '--yes',
264                                          '--output', $certring,
265                                          '--dearmor', $cert);
266        } else {
267
0
0
            $rc = $self->dearmor('PUBLIC KEY BLOCK', $cert, $certring);
268        }
269
1398
50
2360
        $certring = $cert if $rc;
270
1398
6445
        push @exec, '--keyring', $certring;
271    }
272
1398
50
2399
    push @exec, '--output', $data if defined $data;
273
1398
50
4863
    if (! $self->{cmdv}) {
274
0
0
        push @exec, '--verify';
275    }
276
1398
100
2869
    push @exec, $sig if defined $sig;
277
1398
2133
    push @exec, $signeddata;
278
279
1398
3858
    my $rc = $self->_gpg_exec(@exec);
280
1368
50
3740
    return OPENPGP_NO_SIG if $rc;
281
1368
8116
    return OPENPGP_OK;
282}
283
284sub inline_verify {
285
864
864
0
2146
    my ($self, $inlinesigned, $data, @certs) = @_;
286
287
864
2630
    return $self->_gpg_verify($inlinesigned, undef, $data, @certs);
288}
289
290sub verify {
291
564
564
0
1664
    my ($self, $data, $sig, @certs) = @_;
292
293
564
1910
    return $self->_gpg_verify($data, $sig, undef, @certs);
294}
295
296sub inline_sign {
297
264
264
0
652
    my ($self, $data, $inlinesigned, $key) = @_;
298
299
264
50
552
    return OPENPGP_MISSING_CMD if ! $self->has_backend_cmd();
300
301
264
14056
    my $file = basename($data);
302
264
2298
    my $signdir = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
303
264
78198
    my $signfile = "$signdir/$file";
304
305    # Make sure the file to sign ends with a newline, as GnuPG does not adhere
306    # to the OpenPGP specification (see <https://dev.gnupg.org/T7106>).
307
264
2676
    copy($data, $signfile);
308
264
50
43000
    open my $signfh, '>>', $signfile
309        or syserr(g_('cannot open %s'), $signfile);
310
264
264
314
866
    print { $signfh } "\n";
311
264
50
1306
    close $signfh or syserr(g_('cannot close %s'), $signfile);
312
313
264
778
    my @exec = ($self->{cmd});
314
264
540
    push @exec, _gpg_options_weak_digests();
315
264
640
    push @exec, qw(--utf8-strings --textmode --armor);
316    # Set conformance level.
317
264
514
    push @exec, '--openpgp';
318    # Set secure algorithm preferences.
319
264
502
    push @exec, '--personal-digest-preferences', 'SHA512 SHA384 SHA256 SHA224';
320
264
50
0
778
    if ($key->type eq 'keyfile') {
321        # Promote the keyfile keyhandle to a keystore, this way we share the
322        # same gpg-agent and can get any password cached.
323
264
916
        my $gpg_home = File::Temp->newdir('dpkg-sign.XXXXXXXX', TMPDIR => 1);
324
325
264
53050
        push @exec, '--homedir', $gpg_home;
326
264
728
        $self->_gpg_exec(@exec, qw(--quiet --no-tty --batch --import), $key->handle);
327
258
2627
        $key->set('keystore', $gpg_home);
328    } elsif ($key->type eq 'keystore') {
329
0
0
        push @exec, '--homedir', $key->handle;
330    } else {
331
0
0
        push @exec, '--local-user', $key->handle;
332    }
333
258
933
    push @exec, '--output', $inlinesigned;
334
335
258
860
    my $rc = $self->_gpg_exec(@exec, '--clearsign', $data);
336
252
50
1020
    return OPENPGP_CMD_CANNOT_SIGN if $rc;
337
252
3408
    return OPENPGP_OK;
338}
339
340 - 346
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
347
3481;