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