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