File: | Dpkg/OpenPGP/Backend/GnuPG.pm |
Coverage: | 75.8% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
16 | package Dpkg::OpenPGP::Backend::GnuPG; | ||||||
17 | |||||||
18 | 30 30 30 | 180 60 780 | use strict; | ||||
19 | 30 30 30 | 90 30 2070 | use warnings; | ||||
20 | |||||||
21 | our $VERSION = '0.01'; | ||||||
22 | |||||||
23 | 30 30 30 | 120 30 330 | use POSIX qw(:sys_wait_h); | ||||
24 | 30 30 30 | 17190 185760 1350 | use File::Temp; | ||||
25 | 30 30 30 | 262440 348510 5790 | use MIME::Base64; | ||||
26 | |||||||
27 | 30 30 30 | 450 90 6660 | use Dpkg::ErrorHandling; | ||||
28 | 30 30 30 | 270 120 2610 | use Dpkg::IPC; | ||||
29 | 30 30 30 | 26640 150 3210 | use Dpkg::File; | ||||
30 | 30 30 30 | 300 60 2100 | use Dpkg::Path qw(find_command); | ||||
31 | 30 30 30 | 240 60 4590 | use Dpkg::OpenPGP::ErrorCodes; | ||||
32 | |||||||
33 | 30 30 30 | 450 90 420 | use parent qw(Dpkg::OpenPGP::Backend); | ||||
34 | |||||||
35 | sub DEFAULT_CMDV { | ||||||
36 | 30 | 0 | 210 | return [ qw(gpgv) ]; | |||
37 | } | ||||||
38 | |||||||
39 | sub DEFAULT_CMDSTORE { | ||||||
40 | 30 | 0 | 150 | return [ qw(gpg-agent) ]; | |||
41 | } | ||||||
42 | |||||||
43 | sub DEFAULT_CMD { | ||||||
44 | 30 | 0 | 180 | return [ qw(gpg) ]; | |||
45 | } | ||||||
46 | |||||||
47 | sub has_backend_cmd { | ||||||
48 | 52 | 0 | 130 | my $self = shift; | |||
49 | |||||||
50 | 52 | 260 | return defined $self->{cmd} && defined $self->{cmdstore}; | ||||
51 | } | ||||||
52 | |||||||
53 | sub has_keystore { | ||||||
54 | 26 | 0 | 52 | my $self = shift; | |||
55 | |||||||
56 | 26 | 26 | return 0 if not defined $self->{cmdstore}; | ||||
57 | return 1 if ($ENV{GNUPGHOME} && -e $ENV{GNUPGHOME}) || | ||||||
58 | 26 | 260 | ($ENV{HOME} && -e "$ENV{HOME}/.gnupg"); | ||||
59 | 0 | 0 | return 0; | ||||
60 | } | ||||||
61 | |||||||
62 | sub can_use_key { | ||||||
63 | 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 | |||||||
69 | sub has_verify_cmd { | ||||||
70 | 138 | 0 | 138 | my $self = shift; | |||
71 | |||||||
72 | 138 | 384 | return defined $self->{cmdv} || defined $self->{cmd}; | ||||
73 | } | ||||||
74 | |||||||
75 | sub get_trusted_keyrings { | ||||||
76 | 0 | 0 | 0 | my $self = shift; | |||
77 | |||||||
78 | 0 | 0 | my @keyrings; | ||||
79 | 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 | |||||||
93 | sub _pgp_dearmor_data { | ||||||
94 | 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 | 4043 | if ($data =~ m/$armor_regex/) { | ||||
109 | 228 | 2244 | return decode_base64($1); | ||||
110 | } | ||||||
111 | 60 | 840 | return; | ||||
112 | } | ||||||
113 | |||||||
114 | sub _pgp_armor_checksum { | ||||||
115 | 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 | 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 | |||||||
143 | sub _pgp_armor_data { | ||||||
144 | 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 | |||||||
159 | sub armor { | ||||||
160 | 90 | 0 | 240 | my ($self, $type, $in, $out) = @_; | |||
161 | |||||||
162 | 90 | 210 | my $raw_data = file_slurp($in); | ||||
163 | 90 | 210 | my $data = _pgp_dearmor_data($type, $raw_data) // $raw_data; | ||||
164 | 90 | 180 | my $armor = _pgp_armor_data($type, $data); | ||||
165 | 90 | 120 | return OPENPGP_BAD_DATA unless defined $armor; | ||||
166 | 90 | 120 | file_dump($out, $armor); | ||||
167 | |||||||
168 | 90 | 360 | return OPENPGP_OK; | ||||
169 | } | ||||||
170 | |||||||
171 | sub dearmor { | ||||||
172 | 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 | 456 | return OPENPGP_BAD_DATA unless defined $data; | ||||
177 | 198 | 375 | file_dump($out, $data); | ||||
178 | |||||||
179 | 198 | 4035 | return OPENPGP_OK; | ||||
180 | } | ||||||
181 | |||||||
182 | sub _gpg_exec | ||||||
183 | { | ||||||
184 | 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 | 2032 | if (WIFEXITED($?)) { | ||||
190 | 182 | 337 | my $status = WEXITSTATUS($?); | ||||
191 | 182 0 | 367 0 | print { *STDERR } "$stdout$stderr" if $status; | ||||
192 | 182 | 1579 | return $status; | ||||
193 | } else { | ||||||
194 | 0 | 0 | subprocerr("@exec"); | ||||
195 | } | ||||||
196 | } | ||||||
197 | |||||||
198 | sub _gpg_options_weak_digests { | ||||||
199 | my @gpg_weak_digests = map { | ||||||
200 | 164 328 | 188 518 | (qw(--weak-digest), $_) | ||||
201 | } qw(SHA1 RIPEMD160); | ||||||
202 | |||||||
203 | 164 | 324 | return @gpg_weak_digests; | ||||
204 | } | ||||||
205 | |||||||
206 | sub _gpg_verify { | ||||||
207 | 138 | 275 | my ($self, $signeddata, $sig, $data, @certs) = @_; | ||||
208 | |||||||
209 | 138 | 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 | 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 | 162 | $certring = $cert if $rc; | ||||
226 | 138 | 168 | push @exec, '--keyring', $certring; | ||||
227 | } | ||||||
228 | 138 | 162 | push @exec, '--output', $data if defined $data; | ||||
229 | 138 | 194 | if (! $self->{cmdv}) { | ||||
230 | 0 | 0 | push @exec, '--verify'; | ||||
231 | } | ||||||
232 | 138 | 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 | 156 | return OPENPGP_NO_SIG if $rc; | ||||
237 | 133 | 521 | return OPENPGP_OK; | ||||
238 | } | ||||||
239 | |||||||
240 | sub inline_verify { | ||||||
241 | 83 | 0 | 131 | my ($self, $inlinesigned, $data, @certs) = @_; | |||
242 | |||||||
243 | 83 | 189 | return $self->_gpg_verify($inlinesigned, undef, $data, @certs); | ||||
244 | } | ||||||
245 | |||||||
246 | sub verify { | ||||||
247 | 55 | 0 | 195 | my ($self, $data, $sig, @certs) = @_; | |||
248 | |||||||
249 | 55 | 166 | return $self->_gpg_verify($data, $sig, undef, @certs); | ||||
250 | } | ||||||
251 | |||||||
252 | sub inline_sign { | ||||||
253 | 26 | 0 | 130 | my ($self, $data, $inlinesigned, $key) = @_; | |||
254 | |||||||
255 | 26 | 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 | 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 | 192 | return OPENPGP_KEY_CANNOT_SIGN if $rc; | ||||
277 | 24 | 552 | return OPENPGP_OK; | ||||
278 | } | ||||||
279 | |||||||
280 | 1; |