caff/caff

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