caff/pgp-clean

   1 #!/usr/bin/perl -w
   2
   3 # pgp-clean  --  remove all non-self signatures from key
   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-clean -- remove all non-self signatures from key
  37
  38 =head1 SYNOPSIS
  39
  40 =over
  41
  42 =item B<pgp-clean> I<keyid> [I<keyid> ...]
  43
  44 =back
  45
  46 =head1 DESCRIPTION
  47
  48 B<pgp-clean> takes a list of keyids on the command line and outputs an
  49 ascii-armored keyring on stdout for each key with all signatures except
  50 self-signatures stripped.  Its use is to reduce the size of keys sent out after
  51 signing (e.g. with B<caff>).
  52
  53 =head1 OPTIONS
  54
  55 =over
  56
  57 =item I<keyid>
  58
  59 Use this key.
  60
  61 =back
  62
  63 =head1 FILES
  64
  65 =over
  66
  67 =item $HOME/.gnupg/pubring.gpg  -  default GnuPG keyring
  68
  69 =back
  70
  71 =head1 SEE ALSO
  72
  73 caff(1), gpg(1).
  74
  75 =head1 AUTHOR
  76
  77 Peter Palfrader <peter@palfrader.org>
  78
  79 This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
  80
  81 =cut
  82
  83 use strict;
  84 use IO::Handle;
  85 use English;
  86 use File::Path;
  87 use File::Temp qw{tempdir};
  88 use Fcntl;
  89 use IO::Select;
  90 use GnuPG::Interface;
  91
  92 my $REVISION = '$Rev$';
  93 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
  94 my $VERSION = "0.0.0.$REVISION_NUMER";
  95
  96 sub notice($) {
  97         my ($line) = @_;
  98         print STDERR "[NOTICE] $line\n";
  99 };
 100 sub info($) {
 101         my ($line) = @_;
 102         print STDERR "[INFO] $line\n";
 103 };
 104 sub debug($) {
 105         my ($line) = @_;
 106         #print STDERR "[DEBUG] $line\n";
 107 };
 108 sub trace($) {
 109         my ($line) = @_;
 110         #print STDERR "[trace] $line\n";
 111 };
 112 sub trace2($) {
 113         my ($line) = @_;
 114         #print STDERR "[trace2] $line\n";
 115 };
 116
 117 sub make_gpg_fds() {
 118         my %fds = (
 119                 stdin => IO::Handle->new(),
 120                 stdout => IO::Handle->new(),
 121                 stderr => IO::Handle->new(),
 122                 status => IO::Handle->new() );
 123         my $handles = GnuPG::Handles->new( %fds );
 124         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 125 };
 126
 127 sub readwrite_gpg($$$$$%) {
 128         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 129
 130         trace("Entering readwrite_gpg.");
 131
 132         my ($first_line, $dummy) = split /\n/, $in;
 133         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 134
 135         local $INPUT_RECORD_SEPARATOR = undef;
 136         my $sout = IO::Select->new();
 137         my $sin = IO::Select->new();
 138         my $offset = 0;
 139
 140         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 141
 142         $inputfd->blocking(0);
 143         $stdoutfd->blocking(0);
 144         $statusfd->blocking(0) if defined $statusfd;
 145         $stderrfd->blocking(0);
 146         $sout->add($stdoutfd);
 147         $sout->add($stderrfd);
 148         $sout->add($statusfd) if defined $statusfd;
 149         $sin->add($inputfd);
 150
 151         my ($stdout, $stderr, $status) = ("", "", "");
 152         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 153         trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 154
 155         my $readwrote_stuff_this_time = 0;
 156         my $do_not_wait_on_select = 0;
 157         my ($readyr, $readyw, $written);
 158         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 159                 if (defined $exitwhenstatusmatches) {
 160                         if ($status =~ /$exitwhenstatusmatches/m) {
 161                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 162                                 if ($readwrote_stuff_this_time) {
 163                                         trace("read/write some more\n");
 164                                         $do_not_wait_on_select = 1;
 165                                 } else {
 166                                         trace("that's it in our while loop.\n");
 167                                         last;
 168                                 }
 169                         };
 170                 };
 171
 172                 $readwrote_stuff_this_time = 0;
 173                 trace("select waiting for ".($sout->count())." fds.");
 174                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
 175                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 176                 for my $wfd (@$readyw) {
 177                         $readwrote_stuff_this_time = 1;
 178                         if (length($in) != $offset) {
 179                                 trace("writing to $wfd.");
 180                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 181                                 $offset += $written;
 182                         };
 183                         if ($offset == length($in)) {
 184                                 trace("writing to $wfd done.");
 185                                 unless ($options{'nocloseinput'}) {
 186                                         close $wfd;
 187                                         trace("$wfd closed.");
 188                                 };
 189                                 $sin->remove($wfd);
 190                                 $sin = undef;
 191                         }
 192                 }
 193
 194                 next unless (defined(@$readyr)); # Wait some more.
 195
 196                 for my $rfd (@$readyr) {
 197                         $readwrote_stuff_this_time = 1;
 198                         if ($rfd->eof) {
 199                                 trace("reading from $rfd done.");
 200                                 $sout->remove($rfd);
 201                                 close($rfd);
 202                                 next;
 203                         }
 204                         trace("reading from $rfd.");
 205                         if ($rfd == $stdoutfd) {
 206                                 $stdout .= <$rfd>;
 207                                 trace2("stdout is now $stdout\n================");
 208                                 next;
 209                         }
 210                         if (defined $statusfd && $rfd == $statusfd) {
 211                                 $status .= <$rfd>;
 212                                 trace2("status is now $status\n================");
 213                                 next;
 214                         }
 215                         if ($rfd == $stderrfd) {
 216                                 $stderr .= <$rfd>;
 217                                 trace2("stderr is now $stderr\n================");
 218                                 next;
 219                         }
 220                 }
 221         }
 222         trace("readwrite_gpg done.");
 223         return ($stdout, $stderr, $status);
 224 };
 225
 226 sub export_key($$) {
 227         my ($gnupghome, $keyid) = @_;
 228
 229         my $gpg = GnuPG::Interface->new();
 230         my %confighash = ( armor => 1 );
 231         $confighash{'homedir'}=$gnupghome if (defined $gnupghome);
 232         $gpg->options->hash_init( %confighash );
 233         $gpg->options->meta_interactive( 0 );
 234         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 235         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 236         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 237         waitpid $pid, 0;
 238
 239         return $stdout;
 240 };
 241
 242 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 243 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 244 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 245 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 246 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 247
 248
 249 sub usage() {
 250         print STDERR "pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n";
 251         print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
 252         exit 1;
 253 };
 254
 255 usage() unless scalar @ARGV >= 1;
 256 my @KEYIDS;
 257 for my $keyid (@ARGV) {
 258         $keyid =~ s/^0x//i;
 259         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
 260                 print STDERR "$keyid is not a keyid.\n";
 261                 usage();
 262         };
 263         push @KEYIDS, uc($keyid);
 264 };
 265
 266
 267
 268 ##################
 269 # export and prune
 270 ##################
 271 KEYS:
 272 for my $keyid (@KEYIDS) {
 273         # get key listing
 274         #################
 275         my $gpg = GnuPG::Interface->new();
 276         $gpg->options->meta_interactive( 0 );
 277         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 278         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 279         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 280         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 281         waitpid $pid, 0;
 282         if ($stdout eq '') {
 283                 warn ("No data from gpg for list-key $keyid\n");
 284                 next;
 285         };
 286         my $keyinfo = $stdout;
 287         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 288         my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
 289         my $can_encrypt = $flags =~ /E/;
 290         unless (defined $longkeyid) {
 291                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 292                 next;
 293         };
 294
 295         # export the key
 296         ################
 297         my $asciikey = export_key(undef, $keyid);
 298         if ($asciikey eq '') {
 299                 warn ("No data from gpg for export $keyid\n");
 300                 next;
 301         };
 302
 303         my @UIDS;
 304         my $uid_number = 0;
 305         my $this_uid_text = '';
 306         $uid_number++;
 307         debug("Doing key $keyid, uid $uid_number");
 308
 309         # import into temporary gpghome
 310         ###############################
 311         my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 312         $gpg = GnuPG::Interface->new();
 313         $gpg->options->hash_init( 'homedir' => $tempdir );
 314         $gpg->options->meta_interactive( 0 );
 315         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 316         $pid = $gpg->import_keys(handles => $handles);
 317         ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 318         waitpid $pid, 0;
 319
 320         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 321                 warn ("Could not import $keyid into temporary gnupg.\n");
 322                 next;
 323         };
 324
 325         # prune it
 326         ##########
 327         $gpg = GnuPG::Interface->new();
 328         $gpg->options->hash_init(
 329                 'homedir' => $tempdir,
 330                 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 331         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 332         $pid = $gpg->wrap_call(
 333                 commands     => [ '--edit' ],
 334                 command_args => [ $keyid ],
 335                 handles      => $handles );
 336
 337         debug("Starting edit session");
 338         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 339
 340         # mark all uids
 341         ###################
 342         my $number_of_subkeys = 0;
 343         my $i = 1;
 344         my $have_one = 0;
 345         my $is_uat = 0;
 346         my $delete_some = 0;
 347         debug("Parsing stdout output.");
 348         for my $line (split /\n/, $stdout) {
 349                 debug("Checking line $line");
 350                 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
 351                 if ($type eq 'sub') {
 352                         $number_of_subkeys++;
 353                 };
 354                 next unless ($type eq 'uid' || $type eq 'uat');
 355                 debug("line is interesting.");
 356                 debug("mark uid.");
 357                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 358                 $i++;
 359         };
 360         debug("Parsing stdout output done.");
 361
 362         # delete subkeys
 363         ################
 364         if ($number_of_subkeys > 0) {
 365                 for (my $i=1; $i<=$number_of_subkeys; $i++) {
 366                         readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 367                 };
 368                 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 369                 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 370         };
 371
 372         # delete signatures
 373         ###################
 374         my $signed_by_me = 0;
 375         ($stdout, $stderr, $status) =
 376                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 377
 378         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 379                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 380                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 381                 $stdout =~ s/\n/\\n/g;
 382                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 383                 my $line = pop @sigline;
 384                 my $answer = "no";
 385                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 386                         debug("[sigremoval] doing line $line.");
 387                         my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
 388                         if ($signer eq $longkeyid) {
 389                                 debug("[sigremoval] selfsig ($signer).");
 390                                 $answer = "no";
 391                         } else {
 392                                 debug("[sigremoval] not interested in that sig ($signer).");
 393                                 $answer = "yes";
 394                         };
 395                 } else {
 396                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 397                 };
 398                 ($stdout, $stderr, $status) =
 399                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 400         };
 401         readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 402         waitpid $pid, 0;
 403
 404         $asciikey = export_key($tempdir, $longkeyid);
 405         if ($asciikey eq '') {
 406                 warn ("No data from gpg for export $longkeyid\n");
 407                 next;
 408         };
 409
 410
 411         print $asciikey;
 412 }