]> git.sthu.org Git - pgp-tools.git/blob - caff/pgp-fixkey
* caff:
[pgp-tools.git] / caff / pgp-fixkey
1 #!/usr/bin/perl -w
2
3 # pgp-fixkey -- remove broken packets from keys
4 # $Id$
5 #
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 #
8 # All rights reserved.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
12 # are met:
13 # 1. Redistributions of source code must retain the above copyright
14 # notice, this list of conditions and the following disclaimer.
15 # 2. Redistributions in binary form must reproduce the above copyright
16 # notice, this list of conditions and the following disclaimer in the
17 # documentation and/or other materials provided with the distribution.
18 # 3. The name of the author may not be used to endorse or promote products
19 # derived from this software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
22 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
23 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
24 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
26 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
30 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32 =pod
33
34 =head1 NAME
35
36 pgp-fixkey -- remove broken packets from keys
37
38 =head1 SYNOPSIS
39
40 =over
41
42 =item B<pgp-fixkey> [I<keyid> [I<keyid> ...]]
43
44 =back
45
46 =head1 DESCRIPTION
47
48 B<pgp-fixkey> removes broken packets from keys in the GnuPG keyring that make
49 GnuPG spew ugly warnings. It optionally takes a list of keyids on the command
50 line and only cleans those keys.
51
52 =head1 OPTIONS
53
54 =over
55
56 =item I<keyid>
57
58 Use this key.
59
60 =back
61
62 =head1 FILES
63
64 =over
65
66 =item $HOME/.gnupg/pubring.gpg - default GnuPG keyring
67
68 =back
69
70 =head1 SEE ALSO
71
72 caff(1), gpg(1).
73
74 =head1 AUTHOR
75
76 Peter Palfrader <peter@palfrader.org>
77
78 =cut
79
80 use strict;
81 use IO::Handle;
82 use English;
83 use File::Path;
84 use Fcntl;
85 use IO::Select;
86 use GnuPG::Interface;
87
88 my $REVISION = '$Rev$';
89 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
90 my $VERSION = "0.0.0.$REVISION_NUMER";
91
92 sub notice($) {
93 my ($line) = @_;
94 print STDERR "[NOTICE] $line\n";
95 };
96 sub info($) {
97 my ($line) = @_;
98 print STDERR "[INFO] $line\n";
99 };
100 sub debug($) {
101 my ($line) = @_;
102 #print STDERR "[DEBUG] $line\n";
103 };
104 sub trace($) {
105 my ($line) = @_;
106 #print STDERR "[trace] $line\n";
107 };
108 sub trace2($) {
109 my ($line) = @_;
110 #print STDERR "[trace2] $line\n";
111 };
112
113 sub make_gpg_fds() {
114 my %fds = (
115 stdin => IO::Handle->new(),
116 stdout => IO::Handle->new(),
117 stderr => IO::Handle->new(),
118 status => IO::Handle->new() );
119 my $handles = GnuPG::Handles->new( %fds );
120 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
121 };
122
123 sub readwrite_gpg($$$$$%) {
124 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
125
126 trace("Entering readwrite_gpg.");
127
128 my ($first_line, $dummy) = split /\n/, $in;
129 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
130
131 local $INPUT_RECORD_SEPARATOR = undef;
132 my $sout = IO::Select->new();
133 my $sin = IO::Select->new();
134 my $offset = 0;
135
136 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
137
138 $inputfd->blocking(0);
139 $stdoutfd->blocking(0);
140 $statusfd->blocking(0) if defined $statusfd;
141 $stderrfd->blocking(0);
142 $sout->add($stdoutfd);
143 $sout->add($stderrfd);
144 $sout->add($statusfd) if defined $statusfd;
145 $sin->add($inputfd);
146
147 my ($stdout, $stderr, $status) = ("", "", "");
148 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
149 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
150
151 my $readwrote_stuff_this_time = 0;
152 my $do_not_wait_on_select = 0;
153 my ($readyr, $readyw, $written);
154 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
155 if (defined $exitwhenstatusmatches) {
156 if ($status =~ /$exitwhenstatusmatches/m) {
157 trace("readwrite_gpg found match on $exitwhenstatusmatches");
158 if ($readwrote_stuff_this_time) {
159 trace("read/write some more\n");
160 $do_not_wait_on_select = 1;
161 } else {
162 trace("that's it in our while loop.\n");
163 last;
164 }
165 };
166 };
167
168 $readwrote_stuff_this_time = 0;
169 trace("select waiting for ".($sout->count())." fds.");
170 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
171 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
172 for my $wfd (@$readyw) {
173 $readwrote_stuff_this_time = 1;
174 if (length($in) != $offset) {
175 trace("writing to $wfd.");
176 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
177 $offset += $written;
178 };
179 if ($offset == length($in)) {
180 trace("writing to $wfd done.");
181 unless ($options{'nocloseinput'}) {
182 close $wfd;
183 trace("$wfd closed.");
184 };
185 $sin->remove($wfd);
186 $sin = undef;
187 }
188 }
189
190 next unless (defined(@$readyr)); # Wait some more.
191
192 for my $rfd (@$readyr) {
193 $readwrote_stuff_this_time = 1;
194 if ($rfd->eof) {
195 trace("reading from $rfd done.");
196 $sout->remove($rfd);
197 close($rfd);
198 next;
199 }
200 trace("reading from $rfd.");
201 if ($rfd == $stdoutfd) {
202 $stdout .= <$rfd>;
203 trace2("stdout is now $stdout\n================");
204 next;
205 }
206 if (defined $statusfd && $rfd == $statusfd) {
207 $status .= <$rfd>;
208 trace2("status is now $status\n================");
209 next;
210 }
211 if ($rfd == $stderrfd) {
212 $stderr .= <$rfd>;
213 trace2("stderr is now $stderr\n================");
214 next;
215 }
216 }
217 }
218 trace("readwrite_gpg done.");
219 return ($stdout, $stderr, $status);
220 };
221
222 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
223 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
224 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
225 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
226 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
227
228
229 sub usage() {
230 print STDERR "pgp-fixkey $VERSION - (c) 2004, 2005 Peter Palfrader\n";
231 print STDERR "Usage: $PROGRAM_NAME [<keyid> [<keyid> ...]]\n";
232 exit 1;
233 };
234
235 my @KEYIDS;
236 for my $keyid (@ARGV) {
237 $keyid =~ s/^0x//i;
238 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
239 print STDERR "$keyid is not a keyid.\n";
240 usage();
241 };
242 push @KEYIDS, uc($keyid);
243 };
244
245 # find a list of all interesting keys.
246 if (scalar @KEYIDS == 0) {
247 my $gpg = GnuPG::Interface->new();
248 $gpg->options->meta_interactive( 0 );
249 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
250 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fast-list-mode', '--fixed-list-mode' ] );
251 my $pid = $gpg->list_sigs(handles => $handles);
252 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
253 waitpid $pid, 0;
254 if ($stdout eq '') {
255 die ("No data from gpg for list-sigs\n");
256 };
257
258 my $thiskey = undef;
259 for my $line (split /\n/, $stdout) {
260 debug("Checking line $line");
261 my ($type, undef, undef, undef, $keyid, $created, undef, undef, undef, undef) = split /:/, $line;
262 if ($type eq 'pub') {
263 $thiskey = $keyid;
264 debug("Found key $thiskey");
265 } elsif (!defined $thiskey) {
266 next;
267 } elsif ($type eq 'sig' || $type eq 'rev') {
268 if (($keyid eq '0' x 16) || ($created eq "") || ($created == 0)) {
269 push @KEYIDS, $thiskey;
270 info("Key $thiskey needs cleaning.");
271 $thiskey = undef;
272 };
273 };
274 };
275 }
276
277 KEYS:
278 for my $keyid (@KEYIDS) {
279 # get key listing
280 #################
281 my $gpg = GnuPG::Interface->new();
282 $gpg->options->meta_interactive( 0 );
283 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
284 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
285 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
286 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
287 waitpid $pid, 0;
288 if ($stdout eq '') {
289 warn ("No data from gpg for list-key $keyid\n");
290 next;
291 };
292 my $keyinfo = $stdout;
293 my @publine = grep { /^pub/ } (split /\n/, $stdout);
294 if ($#publine < 0) {
295 warn ("No public key found for $keyid.\n");
296 next;
297 }
298 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
299 my $can_encrypt = $flags =~ /E/;
300 unless (defined $longkeyid) {
301 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
302 next;
303 };
304
305 my @UIDS;
306 my $uid_number = 0;
307 my $this_uid_text = '';
308 $uid_number++;
309 debug("Doing key $keyid, uid $uid_number");
310
311 # prune it
312 ##########
313 $gpg = GnuPG::Interface->new();
314 $gpg->options->hash_init(
315 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
316 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
317 $pid = $gpg->wrap_call(
318 commands => [ '--edit' ],
319 command_args => [ $keyid ],
320 handles => $handles );
321
322 debug("Starting edit session");
323 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
324
325 # mark all uids
326 ###################
327 my $number_of_subkeys = 0;
328 my $i = 1;
329 my $have_one = 0;
330 my $is_uat = 0;
331 my $delete_some = 0;
332 debug("Parsing stdout output.");
333 for my $line (split /\n/, $stdout) {
334 debug("Checking line $line");
335 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
336 if ($type eq 'sub') {
337 $number_of_subkeys++;
338 };
339 next unless ($type eq 'uid' || $type eq 'uat');
340 debug("line is interesting.");
341 debug("mark uid.");
342 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
343 $i++;
344 };
345 debug("Parsing stdout output done.");
346
347 # delete signatures
348 ###################
349 ($stdout, $stderr, $status) =
350 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
351
352 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
353 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
354 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
355 $stdout =~ s/\n/\\n/g;
356 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
357 my $line = pop @sigline;
358 my $answer = "no";
359 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
360 debug("[sigremoval] doing line $line.");
361 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
362 if (($signer eq '0' x 16) || ($created == 0)) {
363 debug("[sigremoval] not interested in that sig ($signer, created: $created).");
364 $answer = "yes";
365 };
366 } else {
367 debug("[sigremoval] no sig line here, only got: ".$stdout);
368 };
369 ($stdout, $stderr, $status) =
370 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
371 };
372 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
373 waitpid $pid, 0;
374 }