caff/caff

   1 #!/usr/bin/perl -w
   2
   3 # caff  --  CA - fire and forget
   4 # $Id$
   5 #
   6 # Copyright (c) 2004 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 use strict;
  33 use IO::Handle;
  34 use English;
  35 use File::Path;
  36 use File::Temp qw{tempdir};
  37 use MIME::Entity;
  38 use Fcntl;
  39 use IO::Select;
  40 use GnuPG::Interface;
  41
  42 my %CONFIG;
  43 my $REVISION = '$Rev$';
  44 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
  45 my $VERSION = "0.0.0.$REVISION_NUMER";
  46
  47 sub load_config() {
  48         my $config = $ENV{'HOME'} . '/.caffrc';
  49         -f $config or die "No file $config present.  See caffrc(5).\n";
  50         unless (scalar eval `cat $config`) {
  51                 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
  52         };
  53
  54         die ("caffhome is not defined.\n") unless defined $CONFIG{'caffhome'};
  55         die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
  56         die ("email is not defined.\n") unless defined $CONFIG{'email'};
  57         die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
  58         die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
  59         for my $keyid (@{$CONFIG{'keyid'}}) {
  60                 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
  61         };
  62         @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
  63         $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
  64         $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
  65         $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
  66         $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
  67         $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
  68         $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
  69 };
  70
  71 sub notice($) {
  72         my ($line) = @_;
  73         print "[NOTICE] $line\n";
  74 };
  75 sub info($) {
  76         my ($line) = @_;
  77         print "[INFO] $line\n";
  78 };
  79 sub debug($) {
  80         my ($line) = @_;
  81         #print "[DEBUG] $line\n";
  82 };
  83 sub trace($) {
  84         my ($line) = @_;
  85         #print "[trace] $line\n";
  86 };
  87 sub trace2($) {
  88         my ($line) = @_;
  89         #print "[trace2] $line\n";
  90 };
  91
  92 sub make_gpg_fds() {
  93         my %fds = (
  94                 stdin => IO::Handle->new(),
  95                 stdout => IO::Handle->new(),
  96                 stderr => IO::Handle->new(),
  97                 status => IO::Handle->new() );
  98         my $handles = GnuPG::Handles->new( %fds );
  99         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 100 };
 101
 102 sub readwrite_gpg($$$$$%) {
 103         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 104
 105         trace("Entering readwrite_gpg.");
 106
 107         my ($first_line, $dummy) = split /\n/, $in;
 108         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 109
 110         local $INPUT_RECORD_SEPARATOR = undef;
 111         my $sout = IO::Select->new();
 112         my $sin = IO::Select->new();
 113         my $offset = 0;
 114
 115         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 116
 117         $inputfd->blocking(0);
 118         $stdoutfd->blocking(0);
 119         $statusfd->blocking(0) if defined $statusfd;
 120         $stderrfd->blocking(0);
 121         $sout->add($stdoutfd);
 122         $sout->add($stderrfd);
 123         $sout->add($statusfd) if defined $statusfd;
 124         $sin->add($inputfd);
 125
 126         my ($stdout, $stderr, $status) = ("", "", "");
 127         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 128         trace("doign stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 129
 130         my ($readyr, $readyw, $written);
 131         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 132                 if (defined $exitwhenstatusmatches) {
 133                         if ($status =~ /$exitwhenstatusmatches/m) {
 134                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 135                                 last;
 136                         };
 137                 };
 138
 139                 trace("select waiting for ".($sout->count())." fds.");
 140                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, 1);
 141                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 142                 for my $wfd (@$readyw) {
 143                         if (length($in) != $offset) {
 144                                 trace("writing to $wfd.");
 145                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 146                                 $offset += $written;
 147                         };
 148                         if ($offset == length($in)) {
 149                                 trace("writing to $wfd done.");
 150                                 unless ($options{'nocloseinput'}) {
 151                                         close $wfd;
 152                                         trace("$wfd closed.");
 153                                 };
 154                                 $sin->remove($wfd);
 155                                 $sin = undef;
 156                         }
 157                 }
 158
 159                 next unless (defined(@$readyr)); # Wait some more.
 160
 161                 for my $rfd (@$readyr) {
 162                         if ($rfd->eof) {
 163                                 trace("reading from $rfd done.");
 164                                 $sout->remove($rfd);
 165                                 close($rfd);
 166                                 next;
 167                         }
 168                         trace("reading from $rfd.");
 169                         if ($rfd == $stdoutfd) {
 170                                 $stdout .= <$rfd>;
 171                                 trace2("stdout is now $stdout\n================");
 172                                 next;
 173                         }
 174                         if (defined $statusfd && $rfd == $statusfd) {
 175                                 $status .= <$rfd>;
 176                                 trace2("status is now $status\n================");
 177                                 next;
 178                         }
 179                         if ($rfd == $stderrfd) {
 180                                 $stderr .= <$rfd>;
 181                                 trace2("stderr is now $stderr\n================");
 182                                 next;
 183                         }
 184                 }
 185         }
 186         trace("readwrite_gpg done.");
 187         return ($stdout, $stderr, $status);
 188 };
 189
 190 sub ask($$) {
 191         my ($question, $default) = @_;
 192         my $answer;
 193         while (1) {
 194                 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
 195                 $answer = <STDIN>;
 196                 chomp $answer;
 197                 last if ((defined $answer) && (length $answer <= 1));
 198                 print "grrrrrr.\n";
 199                 sleep 1;
 200         };
 201         my $result = $default;
 202         $result = 1 if $answer =~ /y/i;
 203         $result = 0 if $answer =~ /n/i;
 204         return $result;
 205 };
 206
 207
 208
 209
 210
 211 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 212 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 213 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 214 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 215 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 216
 217 load_config;
 218 my $USER_AGENT = "caff $VERSION - (c) 2004 Peter Palfrader";
 219
 220 my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
 221 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
 222
 223 -d $KEYSBASE  || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
 224 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
 225
 226 my $NOW = time;
 227 my  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
 228 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
 229
 230
 231 sub usage() {
 232         print STDERR "caff $VERSION - (c) 2004 Peter Palfrader\n";
 233         print STDERR "Usage: $PROGRAM_NAME [-u <yourkeyid] <keyid> [<keyid> ...]\n";
 234         exit 1;
 235 };
 236
 237 sub export_key($$) {
 238         my ($gnupghome, $keyid) = @_;
 239
 240         my $gpg = GnuPG::Interface->new();
 241         $gpg->call( $CONFIG{'gpg'} );
 242         $gpg->options->hash_init(
 243                 'homedir' => $gnupghome,
 244                 'armor' => 1 );
 245         $gpg->options->meta_interactive( 0 );
 246         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 247         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 248         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 249         waitpid $pid, 0;
 250
 251         return $stdout;
 252 };
 253
 254 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 255 sub send_mail($$$@) {
 256         my ($address, $can_encrypt, $key_id, @keys) = @_;
 257
 258         my $message = "Hi,\n\n";
 259
 260         $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n";
 261         for my $key (@keys) {
 262                 $message .= "\t".$key->{'text'}."\n";
 263         };
 264         $message .= qq{of your key $key_id signed by me.
 265
 266 Note that I did not upload your key to any keyservers. If you want this
 267 new signature to be available to others, please upload it yourself.
 268 With GnuPG this can be done using
 269         gpg --keyserver subkeys.pgp.net --send-key $key_id
 270
 271 If you have any questions, don't hesitate to ask.
 272
 273 Regards,
 274 $CONFIG{'owner'}
 275 };
 276         my $message_entity = MIME::Entity->build(
 277                 Type        => "text/plain",
 278                 Charset     => "utf-8",
 279                 Disposition => 'inline',
 280                 Data        => $message);
 281
 282         my @key_entities;
 283         for my $key (@keys) {
 284                 $message_entity->attach(
 285                         Type        => "application/pgp-keys",
 286                         Disposition => 'attachment',
 287                         Encoding    => "7bit",
 288                         Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
 289                         Data        => $key->{'key'},
 290                         Filename    => "0x$key_id.".$key->{'serial'}.".asc");
 291         };
 292
 293         if ($can_encrypt) {
 294                 my $message = $message_entity->stringify();
 295
 296                 my $gpg = GnuPG::Interface->new();
 297                 $gpg->call( $CONFIG{'gpg'} );
 298                 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
 299                         'extra_args' => '--always-trust',
 300                         'armor' => 1 );
 301                 $gpg->options->meta_interactive( 0 );
 302                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 303                 $gpg->options->push_recipients( $key_id );
 304                 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
 305                 my $pid = $gpg->encrypt(handles => $handles);
 306                 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 307                 waitpid $pid, 0;
 308                 if ($stdout eq '') {
 309                         warn ("No data from gpg for list-key $key_id\n");
 310                         next;
 311                 };
 312                 $message = $stdout;
 313
 314                 $message_entity = MIME::Entity->build(
 315                         Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');
 316
 317                 $message_entity->attach(
 318                         Type        => "application/pgp-encrypted",
 319                         Disposition => 'attachment',
 320                         Encoding    => "7bit",
 321                         Data        => "Version: 1\n");
 322
 323                 $message_entity->attach(
 324                         Type        => "application/octet-stream",
 325                         Filename    => 'msg.asc',
 326                         Disposition => 'inline',
 327                         Encoding    => "7bit",
 328                         Data        => $message);
 329         };
 330
 331         $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
 332         $message_entity->head->add("To", $address);
 333         $message_entity->head->add("From", $CONFIG{'owner'}.' <'.$CONFIG{'email'}.'>');
 334         $message_entity->head->add("User-Agent", $USER_AGENT);
 335         $message_entity->send();
 336         $message_entity->stringify();
 337 };
 338
 339 my $USER;
 340 my @KEYIDS;
 341
 342 usage() unless scalar @ARGV >= 1;
 343 if ($ARGV[0] eq '-u') {
 344         usage() unless scalar @ARGV >= 3;
 345         shift @ARGV;
 346         $USER = shift @ARGV;
 347         unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
 348                 print STDERR "-u $USER is not a keyid.\n";
 349                 usage();
 350         };
 351         $USER = uc($USER);
 352 };
 353 for my $keyid (@ARGV) {
 354         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
 355                 print STDERR "$keyid is not a keyid.\n";
 356                 usage();
 357         };
 358         push @KEYIDS, uc($keyid);
 359 };
 360
 361
 362 #############################
 363 # receive keys from keyserver
 364 #############################
 365 my $gpg = GnuPG::Interface->new();
 366 $gpg->call( $CONFIG{'gpg'} );
 367 $gpg->options->hash_init(
 368         'homedir' => $GNUPGHOME,
 369         'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 370 $gpg->options->meta_interactive( 0 );
 371 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 372 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
 373 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 374 waitpid $pid, 0;
 375
 376 my @keyids_ok;
 377 my @keyids_failed;
 378 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 379 # [GNUPG:] NODATA 1
 380 # [GNUPG:] NODATA 1
 381 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 382 for my $line (split /\n/, $status) {
 383         if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
 384                 push @keyids_ok, shift @KEYIDS;
 385         } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
 386                 push @keyids_failed, shift @KEYIDS;
 387         };
 388 }
 389 die ("Still keys in \@KEYIDS.  This should not happen.") if scalar @KEYIDS;
 390 notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
 391
 392 ###########
 393 # sign keys
 394 ###########
 395 info("Sign the following keys according to your policy...");
 396 for my $keyid (@keyids_ok) {
 397         my @command;
 398         push @command, $CONFIG{'gpg-sign'};
 399         push @command, '--local-user', $USER if (defined $USER);
 400         push @command, "--homedir=$GNUPGHOME";
 401         push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 402         push @command, '--sign-key', $keyid;
 403         print join(' ', @command),"\n";
 404         system (@command);
 405 };
 406
 407 ##################
 408 # export and prune
 409 ##################
 410 KEYS:
 411 for my $keyid (@keyids_ok) {
 412         # get key listing
 413         #################
 414         $gpg = GnuPG::Interface->new();
 415         $gpg->call( $CONFIG{'gpg'} );
 416         $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
 417         $gpg->options->meta_interactive( 0 );
 418         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 419         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 420         $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 421         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 422         waitpid $pid, 0;
 423         if ($stdout eq '') {
 424                 warn ("No data from gpg for list-key $keyid\n");
 425                 next;
 426         };
 427         my $keyinfo = $stdout;
 428         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 429         my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
 430         my $can_encrypt = $flags =~ /E/;
 431         unless (defined $longkeyid) {
 432                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 433                 next;
 434         };
 435
 436         # export the key
 437         ################
 438         my $asciikey = export_key($GNUPGHOME, $keyid);
 439         if ($asciikey eq '') {
 440                 warn ("No data from gpg for export $keyid\n");
 441                 next;
 442         };
 443
 444         my @UIDS;
 445         my $uid_number = 0;
 446         while (1) {
 447                 my $this_uid_text = '';
 448                 $uid_number++;
 449                 info("Doing key $keyid, uid $uid_number");
 450
 451                 # import into temporary gpghome
 452                 ###############################
 453                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 454                 my $gpg = GnuPG::Interface->new();
 455                 $gpg->call( $CONFIG{'gpg'} );
 456                 $gpg->options->hash_init( 'homedir' => $tempdir );
 457                 $gpg->options->meta_interactive( 0 );
 458                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 459                 my $pid = $gpg->import_keys(handles => $handles);
 460                 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 461                 waitpid $pid, 0;
 462
 463                 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 464                         warn ("Could not import $keyid into temporary gnupg.\n");
 465                         next;
 466                 };
 467
 468                 # prune it
 469                 ##########
 470                 $gpg = GnuPG::Interface->new();
 471                 $gpg->call( $CONFIG{'gpg-delsig'} );
 472                 $gpg->options->hash_init(
 473                         'homedir' => $tempdir,
 474                         'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 475                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 476                 $pid = $gpg->wrap_call(
 477                         commands     => [ '--edit' ],
 478                         command_args => [ $keyid ],
 479                         handles      => $handles );
 480
 481                 debug("Starting edit session");
 482                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 483
 484                 # delete other uids
 485                 ###################
 486                 my $number_of_subkeys = 0;
 487                 my $i = 1;
 488                 my $have_one = 0;
 489                 my $is_uat = 0;
 490                 my $delete_some = 0;
 491                 debug("Parsing stdout output.");
 492                 for my $line (split /\n/, $stdout) {
 493                         debug("Checking line $line");
 494                         my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
 495                         if ($type eq 'sub') {
 496                                 $number_of_subkeys++;
 497                         };
 498                         next unless ($type eq 'uid' || $type eq 'uat');
 499                         debug("line is interesting.");
 500                         if ($uid_number != $i) {
 501                                 debug("mark for deletion.");
 502                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 503                                 $delete_some = 1;
 504                         } else {
 505                                 debug("keep it.");
 506                                 $have_one = 1;
 507                                 $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';
 508                                 $is_uat = $type eq 'uat';
 509                         };
 510                         $i++;
 511                 };
 512                 debug("Parsing stdout output done.");
 513                 if ($is_uat) {
 514                         notice("Can't handle attribute userid of key $keyid.");
 515                         next;
 516                 };
 517                 unless ($have_one) {
 518                         info("key $keyid done.");
 519                         last;
 520                 };
 521                 if ($delete_some) {
 522                         debug("need to delete a few uids.");
 523                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
 524                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 525                 };
 526
 527                 # delete subkeys
 528                 ################
 529                 if ($number_of_subkeys > 0) {
 530                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
 531                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 532                         };
 533                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 534                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 535                 };
 536
 537                 # delete signatures
 538                 ###################
 539                 my $signed_by_me = 0;
 540                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 541                 ($stdout, $stderr, $status) =
 542                         readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 543
 544                 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 545                         # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 546                         my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 547                         my $line = pop @sigline;
 548                         my $answer = "no";
 549                         if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 550                                 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
 551                                 if ($signer eq $longkeyid) {
 552                                         $answer = "no";
 553                                 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {
 554                                         $answer = "no";
 555                                         $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 556                                 } else {
 557                                         $answer = "yes";
 558                                 };
 559                         };
 560                         ($stdout, $stderr, $status) =
 561                                 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 562                 };
 563                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 564                 waitpid $pid, 0;
 565
 566                 my $asciikey = export_key($tempdir, $longkeyid);
 567                 if ($asciikey eq '') {
 568                         warn ("No data from gpg for export $longkeyid\n");
 569                         next;
 570                 };
 571
 572                 if ($signed_by_me) {
 573                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
 574                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0);
 575                                 next unless $write;
 576                         };
 577                         my $keydir = "$KEYSBASE/$DATE_STRING";
 578                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
 579
 580                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.$this_uid_text.asc";
 581                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");
 582                         print KEY $asciikey;
 583                         close KEY;
 584
 585                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
 586
 587                         info("$longkeyid $uid_number $this_uid_text done.");
 588                 } else {
 589                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
 590                 };
 591         };
 592
 593         if (scalar @UIDS == 0) {
 594                 info("found no signed uids for $keyid");
 595         } else {
 596                 my @attached ;
 597                 for my $uid (@UIDS) {
 598                         unless ($uid->{'text'} =~ /@/) {
 599                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
 600                                 push @attached, $uid;
 601                         };
 602                 };
 603
 604                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
 605                 for my $uid (@UIDS) {
 606                         if ($uid->{'text'} =~ /@/) {
 607                                 my $address = $uid->{'text'};
 608                                 $address =~ s/.*<(.*)>.*/$1/;
 609                                 my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1);
 610                                 if ($send) {
 611                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 612
 613                                         my $keydir = "$KEYSBASE/$DATE_STRING";
 614                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".$uid->{'text'};
 615                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");
 616                                         print KEY $mail;
 617                                         close KEY;
 618                                 };
 619                         };
 620                 };
 621         };
 622
 623 };
 624
 625
 626
 627
 628 ###############################################################3
 629 #### old fork gpg --edit
 630 =cut
 631                 my ($stdin_read, $stdin_write);
 632                 my ($stdout_read, $stdout_write);
 633                 my ($stderr_read, $stderr_write);
 634                 my ($status_read, $status_write);
 635                 pipe $stdin_read, $stdin_write;
 636                 pipe $stdout_read, $stdout_write;
 637                 pipe $stderr_read, $stderr_write;
 638                 pipe $status_read, $status_write;
 639
 640                 $pid = fork();
 641                 unless ($pid) { # child
 642                         close $stdin_write;
 643                         close $stdout_read;
 644                         close $stderr_read;
 645                         close $status_read;
 646
 647                         my @call;
 648                         push @call, $CONFIG{'gpg-delsig'};
 649                         push @call, "--homedir=$tempdir";
 650                         push @call, '--with-colons';
 651                         push @call, '--fixed-list-mode';
 652                         push @call, '--command-fd=0';
 653                         push @call, "--status-fd=".fileno($status_write);
 654                         push @call, "--no-tty";
 655                         push @call, "--edit";
 656                         push @call, $keyid;
 657
 658                         close STDIN;
 659                         close STDOUT;
 660                         close STDERR;
 661                         open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n");
 662                         open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n");
 663                         open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n");
 664
 665                         fcntl $status_write, F_SETFD, 0;
 666
 667                         exec (@call);
 668                         exit;
 669                 };
 670                 close $stdin_read;
 671                 close $stdout_write;
 672                 close $stderr_write;
 673                 close $status_write;
 674
 675                 $inputfd = $stdin_write;
 676                 $stdoutfd = $stdout_read;
 677                 $stderrfd = $stderr_read;
 678                 $statusfd = $status_read;
 679 =cut