caff/caff

   1 #!/usr/bin/perl -w
   2
   3 # caff  --  CA - Fire and Forget
   4 # $Id$
   5 #
   6 # Copyright (c) 2004, 2005 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 =pod
  33
  34 =head1 NAME
  35
  36 caff -- CA - Fire and Forget
  37
  38 =head1 SYNOPSIS
  39
  40 =over
  41
  42 =item B<caff> [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
  43
  44 =back
  45
  46 =head1 DESCRIPTION
  47
  48 CA Fire and Forget is a script that helps you in keysigning.  It takes a list
  49 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
  50 that you can sign it.  It then mails each key to all its email addresses - only
  51 including the one UID that we send to in each mail, pruned from all but self
  52 sigs and sigs done by you.
  53
  54 =head1 OPTIONS
  55
  56 =over
  57
  58 =item B<-u> I<yourkeyid>
  59
  60 Select the key that is used for signing, in case you have more than one key.
  61
  62 =back
  63
  64 =head1 FILES
  65
  66 =over
  67
  68 =item $HOME/.caffrc  -  configuration file
  69
  70 =back
  71
  72 =head1 CONFIGURATION FILE OPTIONS
  73
  74 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
  75
  76 Example:
  77
  78         $CONFIG{'owner'}       = 'Peter Palfrader';
  79         $CONFIG{'email'}       = 'peter@palfrader.org';
  80
  81 =head2 Valid keys
  82
  83 =over
  84
  85 =item B<caffhome> [string]
  86
  87 Base directory for the files caff stores.  Default: B<$HOME/.caff/>.
  88
  89 =item B<owner> [string]
  90
  91 Your name.  B<REQUIRED>.
  92
  93 =item B<email> [string]
  94
  95 Your email address, used in From: lines.  B<REQUIRED>.
  96
  97 =item B<keyid> [list of keyids]
  98
  99 A list of your keys.  This is used to determine which signatures to keep
 100 in the pruning step.  If you select a key using B<-u> it has to be in
 101 this list.  B<REQUIRED>.
 102
 103 =item B<export-sig-age> [seconds]
 104
 105 Don't export UIDs by default, on which your latest signature is older
 106 than this age.  Default: B<24*60*60> (i.e. one day).
 107
 108 =item B<keyserver> [string]
 109
 110 Keyserver to download keys from.  Default: B<subkeys.pgp.net>.
 111
 112 =item B<gpg> [string]
 113
 114 Path to the GnuPG binary.  Default: B<gpg>.
 115
 116 =item B<gpg-sign> [string]
 117
 118 Path to the GnuPG binary which is used to sign keys.  Default: what
 119 B<gpg> is set to.
 120
 121 =item B<gpg-delsig> [string]
 122
 123 Path to the GnuPG binary which is used to split off signatures.  This is
 124 needed while the upstream GnuPG is not fixed  (there are 2 bugs in the
 125 Debian Bug Tracking System).  Default: what B<gpg> is set to.
 126
 127 =item B<secret-keyring> [string]
 128
 129 Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.
 130
 131 =item B<also-encrypt-to> [keyid]
 132
 133 An additional keyid to encrypt messages to. Default: none.
 134
 135 =item B<no-download> [boolean]
 136
 137 If true, then skip the step of fetching keys from the keyserver.
 138 Default: B<0>.
 139
 140 =item B<no-sign> [boolean]
 141
 142 If true, then skip the signing step. Default: B<0>.
 143
 144 =back
 145
 146 =head1 AUTHOR
 147
 148 Peter Palfrader <peter@palfrader.org>
 149
 150 =cut
 151
 152 use strict;
 153 use IO::Handle;
 154 use English;
 155 use File::Path;
 156 use File::Temp qw{tempdir};
 157 use MIME::Entity;
 158 use Fcntl;
 159 use IO::Select;
 160 use GnuPG::Interface;
 161
 162 my %CONFIG;
 163 my $REVISION = '$Rev$';
 164 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
 165 my $VERSION = "0.0.0.$REVISION_NUMER";
 166
 167 sub load_config() {
 168         my $config = $ENV{'HOME'} . '/.caffrc';
 169         -f $config or die "No file $config present.  See caffrc(5).\n";
 170         unless (scalar eval `cat $config`) {
 171                 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
 172         };
 173
 174         $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
 175         die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
 176         die ("email is not defined.\n") unless defined $CONFIG{'email'};
 177         die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
 178         die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
 179         for my $keyid (@{$CONFIG{'keyid'}}) {
 180                 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
 181         };
 182         @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
 183         $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
 184         $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
 185         $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
 186         $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
 187         $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
 188         $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
 189         $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
 190         $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
 191 };
 192
 193 sub notice($) {
 194         my ($line) = @_;
 195         print "[NOTICE] $line\n";
 196 };
 197 sub info($) {
 198         my ($line) = @_;
 199         print "[INFO] $line\n";
 200 };
 201 sub debug($) {
 202         my ($line) = @_;
 203         #print "[DEBUG] $line\n";
 204 };
 205 sub trace($) {
 206         my ($line) = @_;
 207         #print "[trace] $line\n";
 208 };
 209 sub trace2($) {
 210         my ($line) = @_;
 211         #print "[trace2] $line\n";
 212 };
 213
 214 sub make_gpg_fds() {
 215         my %fds = (
 216                 stdin => IO::Handle->new(),
 217                 stdout => IO::Handle->new(),
 218                 stderr => IO::Handle->new(),
 219                 status => IO::Handle->new() );
 220         my $handles = GnuPG::Handles->new( %fds );
 221         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 222 };
 223
 224 sub readwrite_gpg($$$$$%) {
 225         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 226
 227         trace("Entering readwrite_gpg.");
 228
 229         my ($first_line, $dummy) = split /\n/, $in;
 230         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 231
 232         local $INPUT_RECORD_SEPARATOR = undef;
 233         my $sout = IO::Select->new();
 234         my $sin = IO::Select->new();
 235         my $offset = 0;
 236
 237         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 238
 239         $inputfd->blocking(0);
 240         $stdoutfd->blocking(0);
 241         $statusfd->blocking(0) if defined $statusfd;
 242         $stderrfd->blocking(0);
 243         $sout->add($stdoutfd);
 244         $sout->add($stderrfd);
 245         $sout->add($statusfd) if defined $statusfd;
 246         $sin->add($inputfd);
 247
 248         my ($stdout, $stderr, $status) = ("", "", "");
 249         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 250         trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 251
 252         my $readwrote_stuff_this_time = 0;
 253         my $do_not_wait_on_select = 0;
 254         my ($readyr, $readyw, $written);
 255         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 256                 if (defined $exitwhenstatusmatches) {
 257                         if ($status =~ /$exitwhenstatusmatches/m) {
 258                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 259                                 if ($readwrote_stuff_this_time) {
 260                                         trace("read/write some more\n");
 261                                         $do_not_wait_on_select = 1;
 262                                 } else {
 263                                         trace("that's it in our while loop.\n");
 264                                         last;
 265                                 }
 266                         };
 267                 };
 268
 269                 $readwrote_stuff_this_time = 0;
 270                 trace("select waiting for ".($sout->count())." fds.");
 271                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
 272                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 273                 for my $wfd (@$readyw) {
 274                         $readwrote_stuff_this_time = 1;
 275                         if (length($in) != $offset) {
 276                                 trace("writing to $wfd.");
 277                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 278                                 $offset += $written;
 279                         };
 280                         if ($offset == length($in)) {
 281                                 trace("writing to $wfd done.");
 282                                 unless ($options{'nocloseinput'}) {
 283                                         close $wfd;
 284                                         trace("$wfd closed.");
 285                                 };
 286                                 $sin->remove($wfd);
 287                                 $sin = undef;
 288                         }
 289                 }
 290
 291                 next unless (defined(@$readyr)); # Wait some more.
 292
 293                 for my $rfd (@$readyr) {
 294                         $readwrote_stuff_this_time = 1;
 295                         if ($rfd->eof) {
 296                                 trace("reading from $rfd done.");
 297                                 $sout->remove($rfd);
 298                                 close($rfd);
 299                                 next;
 300                         }
 301                         trace("reading from $rfd.");
 302                         if ($rfd == $stdoutfd) {
 303                                 $stdout .= <$rfd>;
 304                                 trace2("stdout is now $stdout\n================");
 305                                 next;
 306                         }
 307                         if (defined $statusfd && $rfd == $statusfd) {
 308                                 $status .= <$rfd>;
 309                                 trace2("status is now $status\n================");
 310                                 next;
 311                         }
 312                         if ($rfd == $stderrfd) {
 313                                 $stderr .= <$rfd>;
 314                                 trace2("stderr is now $stderr\n================");
 315                                 next;
 316                         }
 317                 }
 318         }
 319         trace("readwrite_gpg done.");
 320         return ($stdout, $stderr, $status);
 321 };
 322
 323 sub ask($$) {
 324         my ($question, $default) = @_;
 325         my $answer;
 326         while (1) {
 327                 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
 328                 $answer = <STDIN>;
 329                 chomp $answer;
 330                 last if ((defined $answer) && (length $answer <= 1));
 331                 print "grrrrrr.\n";
 332                 sleep 1;
 333         };
 334         my $result = $default;
 335         $result = 1 if $answer =~ /y/i;
 336         $result = 0 if $answer =~ /n/i;
 337         return $result;
 338 };
 339
 340
 341
 342
 343
 344 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 345 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 346 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 347 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 348 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 349
 350 load_config;
 351 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader";
 352
 353 my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
 354 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
 355
 356 -d $KEYSBASE  || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
 357 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
 358
 359 my $NOW = time;
 360 my  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
 361 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
 362
 363
 364 sub usage() {
 365         print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
 366         print STDERR "Usage: $PROGRAM_NAME [-u <yourkeyid] <keyid> [<keyid> ...]\n";
 367         exit 1;
 368 };
 369
 370 sub export_key($$) {
 371         my ($gnupghome, $keyid) = @_;
 372
 373         my $gpg = GnuPG::Interface->new();
 374         $gpg->call( $CONFIG{'gpg'} );
 375         $gpg->options->hash_init(
 376                 'homedir' => $gnupghome,
 377                 'armor' => 1 );
 378         $gpg->options->meta_interactive( 0 );
 379         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 380         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 381         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 382         waitpid $pid, 0;
 383
 384         return $stdout;
 385 };
 386
 387 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 388 sub send_mail($$$@) {
 389         my ($address, $can_encrypt, $key_id, @keys) = @_;
 390
 391         my $message = "Hi,\n\n";
 392
 393         $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n";
 394         for my $key (@keys) {
 395                 $message .= "\t".$key->{'text'}."\n";
 396         };
 397         $message .= qq{of your key $key_id signed by me.
 398
 399 Note that I did not upload your key to any keyservers. If you want this
 400 new signature to be available to others, please upload it yourself.
 401 With GnuPG this can be done using
 402         gpg --keyserver subkeys.pgp.net --send-key $key_id
 403
 404 If you have any questions, don't hesitate to ask.
 405
 406 Regards,
 407 $CONFIG{'owner'}
 408 };
 409         my $message_entity = MIME::Entity->build(
 410                 Type        => "text/plain",
 411                 Charset     => "utf-8",
 412                 Disposition => 'inline',
 413                 Data        => $message);
 414
 415         my @key_entities;
 416         for my $key (@keys) {
 417                 $message_entity->attach(
 418                         Type        => "application/pgp-keys",
 419                         Disposition => 'attachment',
 420                         Encoding    => "7bit",
 421                         Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
 422                         Data        => $key->{'key'},
 423                         Filename    => "0x$key_id.".$key->{'serial'}.".asc");
 424         };
 425
 426         if ($can_encrypt) {
 427                 my $message = $message_entity->stringify();
 428
 429                 my $gpg = GnuPG::Interface->new();
 430                 $gpg->call( $CONFIG{'gpg'} );
 431                 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
 432                         'extra_args' => '--always-trust',
 433                         'armor' => 1 );
 434                 $gpg->options->meta_interactive( 0 );
 435                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 436                 $gpg->options->push_recipients( $key_id );
 437                 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
 438                 my $pid = $gpg->encrypt(handles => $handles);
 439                 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 440                 waitpid $pid, 0;
 441                 if ($stdout eq '') {
 442                         warn ("No data from gpg for list-key $key_id\n");
 443                         next;
 444                 };
 445                 $message = $stdout;
 446
 447                 $message_entity = MIME::Entity->build(
 448                         Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');
 449
 450                 $message_entity->attach(
 451                         Type        => "application/pgp-encrypted",
 452                         Disposition => 'attachment',
 453                         Encoding    => "7bit",
 454                         Data        => "Version: 1\n");
 455
 456                 $message_entity->attach(
 457                         Type        => "application/octet-stream",
 458                         Filename    => 'msg.asc',
 459                         Disposition => 'inline',
 460                         Encoding    => "7bit",
 461                         Data        => $message);
 462         };
 463
 464         $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
 465         $message_entity->head->add("To", $address);
 466         $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
 467         $message_entity->head->add("User-Agent", $USER_AGENT);
 468         $message_entity->send();
 469         $message_entity->stringify();
 470 };
 471
 472 sub sanitize_uid($) {
 473         my ($uid) = @_;
 474
 475         my $good_uid = $uid;
 476         $good_uid =~ tr#/:\\#_#;
 477         trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
 478         return $good_uid;
 479 };
 480
 481 my $USER;
 482 my @KEYIDS;
 483
 484 usage() unless scalar @ARGV >= 1;
 485 if ($ARGV[0] eq '-u') {
 486         usage() unless scalar @ARGV >= 3;
 487         shift @ARGV;
 488         $USER = shift @ARGV;
 489         unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
 490                 print STDERR "-u $USER is not a keyid.\n";
 491                 usage();
 492         };
 493         $USER = uc($USER);
 494 };
 495 for my $keyid (@ARGV) {
 496         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
 497                 print STDERR "$keyid is not a keyid.\n";
 498                 usage();
 499         };
 500         push @KEYIDS, uc($keyid);
 501 };
 502
 503
 504
 505 #############################
 506 # receive keys from keyserver
 507 #############################
 508 my @keyids_ok;
 509 my @keyids_failed;
 510 if ($CONFIG{'no-download'}) {
 511         @keyids_ok = @KEYIDS;
 512 } else {
 513         my $gpg = GnuPG::Interface->new();
 514         $gpg->call( $CONFIG{'gpg'} );
 515         $gpg->options->hash_init(
 516                 'homedir' => $GNUPGHOME,
 517                 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 518         $gpg->options->meta_interactive( 0 );
 519         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 520
 521         my @local_keyids = @KEYIDS;
 522         for my $keyid (@local_keyids) {
 523                 info ("fetching $keyid...");
 524                 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
 525                 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 526                 waitpid $pid, 0;
 527
 528 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 529 # [GNUPG:] NODATA 1
 530 # [GNUPG:] NODATA 1
 531 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 532                 my $handled = 0;
 533                 for my $line (split /\n/, $status) {
 534                         if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
 535                                 push @keyids_ok, shift @KEYIDS;
 536                                 $handled = 1;
 537                                 last;
 538                         } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
 539                                 push @keyids_failed, shift @KEYIDS;
 540                                 $handled = 1;
 541                                 last;
 542                         };
 543                 };
 544                 unless ($handled) {
 545                         notice ("Huh, what's up with $keyid?");
 546                         push @keyids_failed, shift @KEYIDS;
 547                 };
 548         };
 549         die ("Still keys in \@KEYIDS.  This should not happen.") if scalar @KEYIDS;
 550         notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
 551 };
 552
 553 ###########
 554 # sign keys
 555 ###########
 556 unless ($CONFIG{'no-sign'}) {
 557         info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
 558         for my $keyid (@keyids_ok) {
 559                 my @command;
 560                 push @command, $CONFIG{'gpg-sign'};
 561                 push @command, '--local-user', $USER if (defined $USER);
 562                 push @command, "--homedir=$GNUPGHOME";
 563                 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 564                 push @command, '--edit', $keyid;
 565                 push @command, 'sign';
 566                 print join(' ', @command),"\n";
 567                 system (@command);
 568         };
 569 };
 570
 571 ##################
 572 # export and prune
 573 ##################
 574 KEYS:
 575 for my $keyid (@keyids_ok) {
 576         # get key listing
 577         #################
 578         my $gpg = GnuPG::Interface->new();
 579         $gpg->call( $CONFIG{'gpg'} );
 580         $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
 581         $gpg->options->meta_interactive( 0 );
 582         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 583         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 584         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 585         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 586         waitpid $pid, 0;
 587         if ($stdout eq '') {
 588                 warn ("No data from gpg for list-key $keyid\n");
 589                 next;
 590         };
 591         my $keyinfo = $stdout;
 592         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 593         my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
 594         my $can_encrypt = $flags =~ /E/;
 595         unless (defined $longkeyid) {
 596                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 597                 next;
 598         };
 599
 600         # export the key
 601         ################
 602         my $asciikey = export_key($GNUPGHOME, $keyid);
 603         if ($asciikey eq '') {
 604                 warn ("No data from gpg for export $keyid\n");
 605                 next;
 606         };
 607
 608         my @UIDS;
 609         my $uid_number = 0;
 610         while (1) {
 611                 my $this_uid_text = '';
 612                 $uid_number++;
 613                 debug("Doing key $keyid, uid $uid_number");
 614
 615                 # import into temporary gpghome
 616                 ###############################
 617                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 618                 my $gpg = GnuPG::Interface->new();
 619                 $gpg->call( $CONFIG{'gpg'} );
 620                 $gpg->options->hash_init( 'homedir' => $tempdir );
 621                 $gpg->options->meta_interactive( 0 );
 622                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 623                 my $pid = $gpg->import_keys(handles => $handles);
 624                 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 625                 waitpid $pid, 0;
 626
 627                 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 628                         warn ("Could not import $keyid into temporary gnupg.\n");
 629                         next;
 630                 };
 631
 632                 # prune it
 633                 ##########
 634                 $gpg = GnuPG::Interface->new();
 635                 $gpg->call( $CONFIG{'gpg-delsig'} );
 636                 $gpg->options->hash_init(
 637                         'homedir' => $tempdir,
 638                         'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 639                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 640                 $pid = $gpg->wrap_call(
 641                         commands     => [ '--edit' ],
 642                         command_args => [ $keyid ],
 643                         handles      => $handles );
 644
 645                 debug("Starting edit session");
 646                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 647
 648                 # delete other uids
 649                 ###################
 650                 my $number_of_subkeys = 0;
 651                 my $i = 1;
 652                 my $have_one = 0;
 653                 my $is_uat = 0;
 654                 my $delete_some = 0;
 655                 debug("Parsing stdout output.");
 656                 for my $line (split /\n/, $stdout) {
 657                         debug("Checking line $line");
 658                         my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
 659                         if ($type eq 'sub') {
 660                                 $number_of_subkeys++;
 661                         };
 662                         next unless ($type eq 'uid' || $type eq 'uat');
 663                         debug("line is interesting.");
 664                         if ($uid_number != $i) {
 665                                 debug("mark for deletion.");
 666                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 667                                 $delete_some = 1;
 668                         } else {
 669                                 debug("keep it.");
 670                                 $have_one = 1;
 671                                 $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';
 672                                 $is_uat = $type eq 'uat';
 673                         };
 674                         $i++;
 675                 };
 676                 debug("Parsing stdout output done.");
 677                 if ($is_uat) {
 678                         notice("Can't handle attribute userid of key $keyid.");
 679                         next;
 680                 };
 681                 unless ($have_one) {
 682                         debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
 683                         info("key $keyid done.");
 684                         last;
 685                 };
 686                 if ($delete_some) {
 687                         debug("need to delete a few uids.");
 688                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
 689                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 690                 };
 691
 692                 # delete subkeys
 693                 ################
 694                 if ($number_of_subkeys > 0) {
 695                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
 696                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 697                         };
 698                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 699                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 700                 };
 701
 702                 # delete signatures
 703                 ###################
 704                 my $signed_by_me = 0;
 705                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 706                 ($stdout, $stderr, $status) =
 707                         readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 708
 709                 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 710                         # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 711                         my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 712                         $stdout =~ s/\n/\\n/g;
 713                         notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 714                         my $line = pop @sigline;
 715                         my $answer = "no";
 716                         if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 717                                 debug("[sigremoval] doing line $line.");
 718                                 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
 719                                 if ($signer eq $longkeyid) {
 720                                         debug("[sigremoval] selfsig ($signer).");
 721                                         $answer = "no";
 722                                 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {
 723                                         debug("[sigremoval] signed by us ($signer).");
 724                                         $answer = "no";
 725                                         $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 726                                 } else {
 727                                         debug("[sigremoval] not interested in that sig ($signer).");
 728                                         $answer = "yes";
 729                                 };
 730                         } else {
 731                                 debug("[sigremoval] no sig line here, only got: ".$stdout);
 732                         };
 733                         ($stdout, $stderr, $status) =
 734                                 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 735                 };
 736                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 737                 waitpid $pid, 0;
 738
 739                 my $asciikey = export_key($tempdir, $longkeyid);
 740                 if ($asciikey eq '') {
 741                         warn ("No data from gpg for export $longkeyid\n");
 742                         next;
 743                 };
 744
 745                 if ($signed_by_me) {
 746                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
 747                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0);
 748                                 next unless $write;
 749                         };
 750                         my $keydir = "$KEYSBASE/$DATE_STRING";
 751                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
 752
 753                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
 754                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");
 755                         print KEY $asciikey;
 756                         close KEY;
 757
 758                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
 759
 760                         info("$longkeyid $uid_number $this_uid_text done.");
 761                 } else {
 762                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
 763                 };
 764         };
 765
 766         if (scalar @UIDS == 0) {
 767                 info("found no signed uids for $keyid");
 768         } else {
 769                 my @attached ;
 770                 for my $uid (@UIDS) {
 771                         trace("UID: $uid->{'text'}\n");
 772                         unless ($uid->{'text'} =~ /@/) {
 773                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
 774                                 push @attached, $uid if $attach;
 775                         };
 776                 };
 777
 778                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
 779                 for my $uid (@UIDS) {
 780                         if ($uid->{'text'} =~ /@/) {
 781                                 my $address = $uid->{'text'};
 782                                 $address =~ s/.*<(.*)>.*/$1/;
 783                                 my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1);
 784                                 if ($send) {
 785                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 786
 787                                         my $keydir = "$KEYSBASE/$DATE_STRING";
 788                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
 789                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");
 790                                         print KEY $mail;
 791                                         close KEY;
 792                                 };
 793                         };
 794                 };
 795         };
 796
 797 };
 798
 799
 800
 801
 802 ###############################################################3
 803 #### old fork gpg --edit
 804 =cut
 805                 my ($stdin_read, $stdin_write);
 806                 my ($stdout_read, $stdout_write);
 807                 my ($stderr_read, $stderr_write);
 808                 my ($status_read, $status_write);
 809                 pipe $stdin_read, $stdin_write;
 810                 pipe $stdout_read, $stdout_write;
 811                 pipe $stderr_read, $stderr_write;
 812                 pipe $status_read, $status_write;
 813
 814                 $pid = fork();
 815                 unless ($pid) { # child
 816                         close $stdin_write;
 817                         close $stdout_read;
 818                         close $stderr_read;
 819                         close $status_read;
 820
 821                         my @call;
 822                         push @call, $CONFIG{'gpg-delsig'};
 823                         push @call, "--homedir=$tempdir";
 824                         push @call, '--with-colons';
 825                         push @call, '--fixed-list-mode';
 826                         push @call, '--command-fd=0';
 827                         push @call, "--status-fd=".fileno($status_write);
 828                         push @call, "--no-tty";
 829                         push @call, "--edit";
 830                         push @call, $keyid;
 831
 832                         close STDIN;
 833                         close STDOUT;
 834                         close STDERR;
 835                         open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n");
 836                         open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n");
 837                         open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n");
 838
 839                         fcntl $status_write, F_SETFD, 0;
 840
 841                         exec (@call);
 842                         exit;
 843                 };
 844                 close $stdin_read;
 845                 close $stdout_write;
 846                 close $stderr_write;
 847                 close $status_write;
 848
 849                 $inputfd = $stdin_write;
 850                 $stdoutfd = $stdout_read;
 851                 $stderrfd = $stderr_read;
 852                 $statusfd = $status_read;
 853 =cut