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 == 0)) {
 269                                 push @KEYIDS, $thiskey;
 270                                 info("Adding $thiskey");
 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         my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 295         my $can_encrypt = $flags =~ /E/;
 296         unless (defined $longkeyid) {
 297                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 298                 next;
 299         };
 300
 301         my @UIDS;
 302         my $uid_number = 0;
 303         my $this_uid_text = '';
 304         $uid_number++;
 305         debug("Doing key $keyid, uid $uid_number");
 306
 307         # prune it
 308         ##########
 309         $gpg = GnuPG::Interface->new();
 310         $gpg->options->hash_init(
 311                 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 312         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 313         $pid = $gpg->wrap_call(
 314                 commands     => [ '--edit' ],
 315                 command_args => [ $keyid ],
 316                 handles      => $handles );
 317
 318         debug("Starting edit session");
 319         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 320
 321         # mark all uids
 322         ###################
 323         my $number_of_subkeys = 0;
 324         my $i = 1;
 325         my $have_one = 0;
 326         my $is_uat = 0;
 327         my $delete_some = 0;
 328         debug("Parsing stdout output.");
 329         for my $line (split /\n/, $stdout) {
 330                 debug("Checking line $line");
 331                 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
 332                 if ($type eq 'sub') {
 333                         $number_of_subkeys++;
 334                 };
 335                 next unless ($type eq 'uid' || $type eq 'uat');
 336                 debug("line is interesting.");
 337                 debug("mark uid.");
 338                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 339                 $i++;
 340         };
 341         debug("Parsing stdout output done.");
 342
 343         # delete signatures
 344         ###################
 345         ($stdout, $stderr, $status) =
 346                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 347
 348         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 349                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 350                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 351                 $stdout =~ s/\n/\\n/g;
 352                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 353                 my $line = pop @sigline;
 354                 my $answer = "no";
 355                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 356                         debug("[sigremoval] doing line $line.");
 357                         my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
 358                         if (($signer eq '0' x 16) || ($created == 0)) {
 359                                 debug("[sigremoval] not interested in that sig ($signer, created: $created).");
 360                                 $answer = "yes";
 361                         };
 362                 } else {
 363                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 364                 };
 365                 ($stdout, $stderr, $status) =
 366                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 367         };
 368         readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 369         waitpid $pid, 0;
 370 }