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 # Copyright (c) 2006 Christoph Berg <cb@df7cb.de>
   8 #
   9 # All rights reserved.
  10 #
  11 # Redistribution and use in source and binary forms, with or without
  12 # modification, are permitted provided that the following conditions
  13 # are met:
  14 # 1. Redistributions of source code must retain the above copyright
  15 #    notice, this list of conditions and the following disclaimer.
  16 # 2. Redistributions in binary form must reproduce the above copyright
  17 #    notice, this list of conditions and the following disclaimer in the
  18 #    documentation and/or other materials provided with the distribution.
  19 # 3. The name of the author may not be used to endorse or promote products
  20 #    derived from this software without specific prior written permission.
  21 #
  22 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  23 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  24 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  25 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  27 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  28 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  29 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  30 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  31 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32
  33 =pod
  34
  35 =head1 NAME
  36
  37 pgp-clean -- remove all non-self signatures from key
  38
  39 =head1 SYNOPSIS
  40
  41 =over
  42
  43 =item B<pgp-clean> [B<-s>] I<keyid> [I<keyid> ...]
  44
  45 =back
  46
  47 =head1 DESCRIPTION
  48
  49 B<pgp-clean> takes a list of keyids on the command line and outputs an
  50 ascii-armored keyring on stdout for each key with all signatures except
  51 self-signatures stripped.  Its use is to reduce the size of keys sent out after
  52 signing (e.g. with B<caff>).
  53
  54 =head1 OPTIONS
  55
  56 =over
  57
  58 =item B<-s> B<--export-subkeys>
  59
  60 Do not remove subkeys. (Pruned by default.)
  61
  62 =item I<keyid>
  63
  64 Use this key.
  65
  66 =back
  67
  68 =head1 FILES
  69
  70 =over
  71
  72 =item $HOME/.gnupg/pubring.gpg  -  default GnuPG keyring
  73
  74 =back
  75
  76 =head1 SEE ALSO
  77
  78 caff(1), gpg(1).
  79
  80 =head1 AUTHOR
  81
  82 Peter Palfrader <peter@palfrader.org>
  83
  84 This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
  85
  86 =cut
  87
  88 use strict;
  89 use IO::Handle;
  90 use English;
  91 use File::Path;
  92 use File::Temp qw{tempdir};
  93 use Fcntl;
  94 use IO::Select;
  95 use Getopt::Long;
  96 use GnuPG::Interface;
  97
  98 my $REVISION = '$Rev$';
  99 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
 100 my $VERSION = "0.0.0.$REVISION_NUMER";
 101
 102 ###########
 103 # functions
 104 ###########
 105
 106 sub notice($) {
 107         my ($line) = @_;
 108         print STDERR "[NOTICE] $line\n";
 109 };
 110 sub info($) {
 111         my ($line) = @_;
 112         print STDERR "[INFO] $line\n";
 113 };
 114 sub debug($) {
 115         my ($line) = @_;
 116         #print STDERR "[DEBUG] $line\n";
 117 };
 118 sub trace($) {
 119         my ($line) = @_;
 120         #print STDERR "[trace] $line\n";
 121 };
 122 sub trace2($) {
 123         my ($line) = @_;
 124         #print STDERR "[trace2] $line\n";
 125 };
 126
 127 sub make_gpg_fds() {
 128         my %fds = (
 129                 stdin => IO::Handle->new(),
 130                 stdout => IO::Handle->new(),
 131                 stderr => IO::Handle->new(),
 132                 status => IO::Handle->new() );
 133         my $handles = GnuPG::Handles->new( %fds );
 134         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 135 };
 136
 137 sub readwrite_gpg($$$$$%) {
 138         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 139
 140         trace("Entering readwrite_gpg.");
 141
 142         my ($first_line, $dummy) = split /\n/, $in;
 143         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 144
 145         local $INPUT_RECORD_SEPARATOR = undef;
 146         my $sout = IO::Select->new();
 147         my $sin = IO::Select->new();
 148         my $offset = 0;
 149
 150         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 151
 152         $inputfd->blocking(0);
 153         $stdoutfd->blocking(0);
 154         $statusfd->blocking(0) if defined $statusfd;
 155         $stderrfd->blocking(0);
 156         $sout->add($stdoutfd);
 157         $sout->add($stderrfd);
 158         $sout->add($statusfd) if defined $statusfd;
 159         $sin->add($inputfd);
 160
 161         my ($stdout, $stderr, $status) = ("", "", "");
 162         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 163         trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 164
 165         my $readwrote_stuff_this_time = 0;
 166         my $do_not_wait_on_select = 0;
 167         my ($readyr, $readyw, $written);
 168         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 169                 if (defined $exitwhenstatusmatches) {
 170                         if ($status =~ /$exitwhenstatusmatches/m) {
 171                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 172                                 if ($readwrote_stuff_this_time) {
 173                                         trace("read/write some more\n");
 174                                         $do_not_wait_on_select = 1;
 175                                 } else {
 176                                         trace("that's it in our while loop.\n");
 177                                         last;
 178                                 }
 179                         };
 180                 };
 181
 182                 $readwrote_stuff_this_time = 0;
 183                 trace("select waiting for ".($sout->count())." fds.");
 184                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
 185                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 186                 for my $wfd (@$readyw) {
 187                         $readwrote_stuff_this_time = 1;
 188                         if (length($in) != $offset) {
 189                                 trace("writing to $wfd.");
 190                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 191                                 $offset += $written;
 192                         };
 193                         if ($offset == length($in)) {
 194                                 trace("writing to $wfd done.");
 195                                 unless ($options{'nocloseinput'}) {
 196                                         close $wfd;
 197                                         trace("$wfd closed.");
 198                                 };
 199                                 $sin->remove($wfd);
 200                                 $sin = undef;
 201                         }
 202                 }
 203
 204                 next unless (defined(@$readyr)); # Wait some more.
 205
 206                 for my $rfd (@$readyr) {
 207                         $readwrote_stuff_this_time = 1;
 208                         if ($rfd->eof) {
 209                                 trace("reading from $rfd done.");
 210                                 $sout->remove($rfd);
 211                                 close($rfd);
 212                                 next;
 213                         }
 214                         trace("reading from $rfd.");
 215                         if ($rfd == $stdoutfd) {
 216                                 $stdout .= <$rfd>;
 217                                 trace2("stdout is now $stdout\n================");
 218                                 next;
 219                         }
 220                         if (defined $statusfd && $rfd == $statusfd) {
 221                                 $status .= <$rfd>;
 222                                 trace2("status is now $status\n================");
 223                                 next;
 224                         }
 225                         if ($rfd == $stderrfd) {
 226                                 $stderr .= <$rfd>;
 227                                 trace2("stderr is now $stderr\n================");
 228                                 next;
 229                         }
 230                 }
 231         }
 232         trace("readwrite_gpg done.");
 233         return ($stdout, $stderr, $status);
 234 };
 235
 236 sub export_key($$) {
 237         my ($gnupghome, $keyid) = @_;
 238
 239         my $gpg = GnuPG::Interface->new();
 240         my %confighash = ( armor => 1 );
 241         $confighash{'homedir'}=$gnupghome if (defined $gnupghome);
 242         $gpg->options->hash_init( %confighash );
 243         $gpg->options->meta_interactive( 0 );
 244         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 245         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 246         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 247         waitpid $pid, 0;
 248
 249         return $stdout;
 250 };
 251
 252 ##################
 253 # global variables
 254 ##################
 255
 256 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 257 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 258 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 259 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 260 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 261 my $params;
 262
 263 ###################
 264 # argument handling
 265 ###################
 266
 267 sub version($) {
 268         my ($fd) = @_;
 269         print $fd "pgp-clean $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
 270 };
 271
 272 sub usage($$) {
 273         my ($fd, $exitcode) = @_;
 274         version($fd);
 275         print $fd "Usage: $PROGRAM_NAME [-s] <keyid> [<keyid> ...]\n";
 276         print $fd "-s --export-subkeys  do not remove subkeys\n";
 277         exit $exitcode;
 278 };
 279
 280 Getopt::Long::config('bundling');
 281 if (!GetOptions (
 282         '-h'               =>  \$params->{'help'},
 283         '--help'           =>  \$params->{'help'},
 284         '-V'               =>  \$params->{'version'},
 285         '--version'        =>  \$params->{'version'},
 286         '-s'               =>  \$params->{'export-subkeys'},
 287         '--export-subkeys' =>  \$params->{'export-subkeys'},
 288         )) {
 289         usage(\*STDERR, 1);
 290 };
 291 if ($params->{'help'}) {
 292         usage(\*STDOUT, 0);
 293 };
 294 if ($params->{'version'}) {
 295         version(\*STDOUT);
 296         exit(0);
 297 };
 298 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
 299
 300 my @KEYIDS;
 301 for my $keyid (@ARGV) {
 302         $keyid =~ s/^0x//i;
 303         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
 304                 print STDERR "$keyid is not a keyid.\n";
 305                 usage(\*STDERR, 1);
 306         };
 307         push @KEYIDS, uc($keyid);
 308 };
 309
 310
 311
 312 ##################
 313 # export and prune
 314 ##################
 315 KEYS:
 316 for my $keyid (@KEYIDS) {
 317         # get key listing
 318         #################
 319         my $gpg = GnuPG::Interface->new();
 320         $gpg->options->meta_interactive( 0 );
 321         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 322         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 323         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 324         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 325         waitpid $pid, 0;
 326         if ($stdout eq '') {
 327                 warn ("No data from gpg for list-key $keyid\n");
 328                 next;
 329         };
 330         my $keyinfo = $stdout;
 331         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 332         my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
 333         my $can_encrypt = $flags =~ /E/;
 334         unless (defined $longkeyid) {
 335                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 336                 next;
 337         };
 338
 339         # export the key
 340         ################
 341         my $asciikey = export_key(undef, $keyid);
 342         if ($asciikey eq '') {
 343                 warn ("No data from gpg for export $keyid\n");
 344                 next;
 345         };
 346
 347         my @UIDS;
 348         my $uid_number = 0;
 349         my $this_uid_text = '';
 350         $uid_number++;
 351         debug("Doing key $keyid, uid $uid_number");
 352
 353         # import into temporary gpghome
 354         ###############################
 355         my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 356         $gpg = GnuPG::Interface->new();
 357         $gpg->options->hash_init( 'homedir' => $tempdir );
 358         $gpg->options->meta_interactive( 0 );
 359         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 360         $pid = $gpg->import_keys(handles => $handles);
 361         ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 362         waitpid $pid, 0;
 363
 364         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 365                 warn ("Could not import $keyid into temporary gnupg.\n");
 366                 next;
 367         };
 368
 369         # prune it
 370         ##########
 371         $gpg = GnuPG::Interface->new();
 372         $gpg->options->hash_init(
 373                 'homedir' => $tempdir,
 374                 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 375         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 376         $pid = $gpg->wrap_call(
 377                 commands     => [ '--edit' ],
 378                 command_args => [ $keyid ],
 379                 handles      => $handles );
 380
 381         debug("Starting edit session");
 382         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 383
 384         # mark all uids
 385         ###################
 386         my $number_of_subkeys = 0;
 387         my $i = 1;
 388         my $have_one = 0;
 389         my $is_uat = 0;
 390         my $delete_some = 0;
 391         debug("Parsing stdout output.");
 392         for my $line (split /\n/, $stdout) {
 393                 debug("Checking line $line");
 394                 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
 395                 if ($type eq 'sub') {
 396                         $number_of_subkeys++;
 397                 };
 398                 next unless ($type eq 'uid' || $type eq 'uat');
 399                 debug("line is interesting.");
 400                 debug("mark uid.");
 401                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 402                 $i++;
 403         };
 404         debug("Parsing stdout output done.");
 405
 406         # delete subkeys
 407         ################
 408         if (!$params->{'export-subkeys'} and $number_of_subkeys > 0) {
 409                 for (my $i=1; $i<=$number_of_subkeys; $i++) {
 410                         readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 411                 };
 412                 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 413                 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 414         };
 415
 416         # delete signatures
 417         ###################
 418         my $signed_by_me = 0;
 419         ($stdout, $stderr, $status) =
 420                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 421
 422         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 423                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 424                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 425                 $stdout =~ s/\n/\\n/g;
 426                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 427                 my $line = pop @sigline;
 428                 my $answer = "no";
 429                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 430                         debug("[sigremoval] doing line $line.");
 431                         my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
 432                         if ($signer eq $longkeyid) {
 433                                 debug("[sigremoval] selfsig ($signer).");
 434                                 $answer = "no";
 435                         } else {
 436                                 debug("[sigremoval] not interested in that sig ($signer).");
 437                                 $answer = "yes";
 438                         };
 439                 } else {
 440                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 441                 };
 442                 ($stdout, $stderr, $status) =
 443                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 444         };
 445         readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 446         waitpid $pid, 0;
 447
 448         $asciikey = export_key($tempdir, $longkeyid);
 449         if ($asciikey eq '') {
 450                 warn ("No data from gpg for export $longkeyid\n");
 451                 next;
 452         };
 453
 454
 455         print $asciikey;
 456 }