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 # Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
   8 #
   9 # All rights reserved.
  10 #
  11 # Redistribution and use in source and binary forms, with or without
  12 # modification, are permitted provided that the following conditions
  13 # are met:
  14 # 1. Redistributions of source code must retain the above copyright
  15 #    notice, this list of conditions and the following disclaimer.
  16 # 2. Redistributions in binary form must reproduce the above copyright
  17 #    notice, this list of conditions and the following disclaimer in the
  18 #    documentation and/or other materials provided with the distribution.
  19 # 3. The name of the author may not be used to endorse or promote products
  20 #    derived from this software without specific prior written permission.
  21 #
  22 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  23 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  24 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  25 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  27 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  28 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  29 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  30 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  31 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32
  33 =pod
  34
  35 =head1 NAME
  36
  37 caff -- CA - Fire and Forget
  38
  39 =head1 SYNOPSIS
  40
  41 =over
  42
  43 =item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
  44
  45 =back
  46
  47 =head1 DESCRIPTION
  48
  49 CA Fire and Forget is a script that helps you in keysigning.  It takes a list
  50 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
  51 that you can sign it.  It then mails each key to all its email addresses - only
  52 including the one UID that we send to in each mail, pruned from all but self
  53 sigs and sigs done by you.
  54
  55 =head1 OPTIONS
  56
  57 =over
  58
  59 =item B<-e>, B<--export-old>
  60
  61 Export old signatures. Default is to ask the user for each old signature.
  62
  63 =item B<-E>, B<--no-export-old>
  64
  65 Do not export old signatures. Default is to ask the user for each old
  66 signature.
  67
  68 =item B<-m>, B<--mail>
  69
  70 Send mail after signing. Default is to ask the user for each uid.
  71
  72 =item B<-M>, B<--no-mail>
  73
  74 Do not send mail after signing. Default is to ask the user for each uid.
  75
  76 =item B<-R>, B<--no-download>
  77
  78 Do not retrieve the key to be signed from a keyserver.
  79
  80 =item B<-S>, B<--no-sign>
  81
  82 Do not sign the keys.
  83
  84 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
  85
  86 Select the key that is used for signing, in case you have more than one key.
  87
  88 =item B<--key-file> I<file>
  89
  90 Import keys from file. Can be supplied more than once.
  91
  92 =back
  93
  94 =head1 FILES
  95
  96 =over
  97
  98 =item $HOME/.caffrc  -  configuration file
  99
 100 =back
 101
 102 =head1 CONFIGURATION FILE OPTIONS
 103
 104 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
 105
 106 Example:
 107
 108         $CONFIG{owner} = q{Peter Palfrader};
 109         $CONFIG{email} = q{peter@palfrader.org};
 110         $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
 111
 112 =head2 Required basic settings
 113
 114 =over
 115
 116 =item B<owner> [string]
 117
 118 Your name.  B<REQUIRED>.
 119
 120 =item B<email> [string]
 121
 122 Your email address, used in From: lines.  B<REQUIRED>.
 123
 124 =item B<keyid> [list of keyids]
 125
 126 A list of your keys.  This is used to determine which signatures to keep
 127 in the pruning step.  If you select a key using B<-u> it has to be in
 128 this list.  B<REQUIRED>.
 129
 130 =head2 General settings
 131
 132 =item B<caffhome> [string]
 133
 134 Base directory for the files caff stores.  Default: B<$HOME/.caff/>.
 135
 136 =head2 GnuPG settings
 137
 138 =item B<gpg> [string]
 139
 140 Path to the GnuPG binary.  Default: B<gpg>.
 141
 142 =item B<gpg-sign> [string]
 143
 144 Path to the GnuPG binary which is used to sign keys.  Default: what
 145 B<gpg> is set to.
 146
 147 =item B<gpg-delsig> [string]
 148
 149 Path to the GnuPG binary which is used to split off signatures.  This was
 150 needed while the upstream GnuPG was not fixed.  Default: what B<gpg>
 151 is set to.
 152
 153 =item B<secret-keyring> [string]
 154
 155 Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.
 156
 157 =item B<also-encrypt-to> [keyid]
 158
 159 An additional keyid to encrypt messages to. Default: none.
 160
 161 =item B<gpg-sign-args> [string]
 162
 163 Additional arguments to pass to gpg.  Default: none.
 164
 165 =head2 Keyserver settings
 166
 167 =item B<keyserver> [string]
 168
 169 Keyserver to download keys from.  Default: B<subkeys.pgp.net>.
 170
 171 =item B<no-download> [boolean]
 172
 173 If true, then skip the step of fetching keys from the keyserver.
 174 Default: B<0>.
 175
 176 =item B<key-files> [list of files]
 177
 178 A list of files containing keys to be imported.
 179
 180 =head2 Signing settings
 181
 182 =item B<no-sign> [boolean]
 183
 184 If true, then skip the signing step. Default: B<0>.
 185
 186 =item B<ask-sign> [boolean]
 187
 188 If true, then pause before continuing to the signing step.
 189 This is useful for offline signing. Default: B<0>.
 190
 191 =item B<export-sig-age> [seconds]
 192
 193 Don't export UIDs by default, on which your latest signature is older
 194 than this age.  Default: B<24*60*60> (i.e. one day).
 195
 196 =head2 Mail settings
 197
 198 =item B<mail> [boolean]
 199
 200 Do not prompt for sending mail, just do it. Default: B<0>.
 201
 202 =item B<no-mail> [boolean]
 203
 204 Do not prompt for sending mail. The messages are still written to
 205 $CONFIG{caffhome}/keys/. Default: B<0>.
 206
 207 =item B<mail-template> [string]
 208
 209 Email template which is used as the body text for the email sent out
 210 instead of the default text if specified. The following perl variables
 211 can be used in the template:
 212
 213 =over
 214
 215 =item B<{owner}> [string]
 216
 217 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
 218
 219 =item B<{key}> [string]
 220
 221 The keyid of the key you signed.
 222
 223 =item B<{@uids}> [array]
 224
 225 The UIDs for which signatures are included in the mail.
 226
 227 =back
 228
 229 =item B<bcc> [string]
 230
 231 Address to send blind carbon copies to when sending mail.
 232 Default: none.
 233
 234 =back
 235
 236 =head1 AUTHORS
 237
 238 =over
 239
 240 =item Peter Palfrader <peter@palfrader.org>
 241
 242 =item Christoph Berg <cb@df7cb.de>
 243
 244 =back
 245
 246 =head1 WEBSITE
 247
 248 http://pgp-tools.alioth.debian.org/
 249
 250 =cut
 251
 252 use strict;
 253 use IO::Handle;
 254 use English;
 255 use File::Path;
 256 use File::Temp qw{tempdir};
 257 use Text::Template;
 258 use MIME::Entity;
 259 use Fcntl;
 260 use IO::Select;
 261 use Getopt::Long;
 262 use GnuPG::Interface;
 263
 264 my %CONFIG;
 265 my $REVISION = '$Rev$';
 266 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
 267 my $VERSION = "0.0.0.$REVISION_NUMER";
 268
 269 sub load_config() {
 270         my $config = $ENV{'HOME'} . '/.caffrc';
 271         -f $config or die "No file $config present.  See caff(1).\n";
 272         unless (scalar eval `cat $config`) {
 273                 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
 274         };
 275
 276         $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
 277         die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
 278         die ("email is not defined.\n") unless defined $CONFIG{'email'};
 279         die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
 280         die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
 281         for my $keyid (@{$CONFIG{'keyid'}}) {
 282                 $keyid =~ /^[A-F0-9]{16}$/i or die ("key $keyid is not a long (16 digit) keyid.\n");
 283         };
 284         @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
 285         $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
 286         $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
 287         $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
 288         $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
 289         $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
 290         $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
 291         $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
 292         $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
 293         $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
 294         $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
 295 Hi,
 296
 297 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
 298 {foreach $uid (@uids) {
 299     $OUT .= "\t".$uid."\n";
 300 };} of your key {$key} signed by me.
 301
 302 Note that I did not upload your key to any keyservers.
 303 If you have multiple user ids, I sent the signature for each user id
 304 separately to that user id's associated email address. You can import
 305 the signatures by running each through `gpg --import`.
 306
 307 If you want this new signature to be available to others, please upload
 308 it yourself. With GnuPG this can be done using
 309         gpg --keyserver subkeys.pgp.net --send-key {$key}
 310
 311 If you have any questions, don't hesitate to ask.
 312
 313 Regards,
 314 {$owner}
 315 EOM
 316 };
 317
 318 sub notice($) {
 319         my ($line) = @_;
 320         print "[NOTICE] $line\n";
 321 };
 322 sub info($) {
 323         my ($line) = @_;
 324         print "[INFO] $line\n";
 325 };
 326 sub debug($) {
 327         my ($line) = @_;
 328         #print "[DEBUG] $line\n";
 329 };
 330 sub trace($) {
 331         my ($line) = @_;
 332         #print "[trace] $line\n";
 333 };
 334 sub trace2($) {
 335         my ($line) = @_;
 336         #print "[trace2] $line\n";
 337 };
 338
 339 sub make_gpg_fds() {
 340         my %fds = (
 341                 stdin => IO::Handle->new(),
 342                 stdout => IO::Handle->new(),
 343                 stderr => IO::Handle->new(),
 344                 status => IO::Handle->new() );
 345         my $handles = GnuPG::Handles->new( %fds );
 346         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 347 };
 348
 349 sub readwrite_gpg($$$$$%) {
 350         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 351
 352         trace("Entering readwrite_gpg.");
 353
 354         my ($first_line, undef) = split /\n/, $in;
 355         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 356
 357         local $INPUT_RECORD_SEPARATOR = undef;
 358         my $sout = IO::Select->new();
 359         my $sin = IO::Select->new();
 360         my $offset = 0;
 361
 362         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 363
 364         $inputfd->blocking(0);
 365         $stdoutfd->blocking(0);
 366         $statusfd->blocking(0) if defined $statusfd;
 367         $stderrfd->blocking(0);
 368         $sout->add($stdoutfd);
 369         $sout->add($stderrfd);
 370         $sout->add($statusfd) if defined $statusfd;
 371         $sin->add($inputfd);
 372
 373         my ($stdout, $stderr, $status) = ("", "", "");
 374         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 375         trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 376
 377         my $readwrote_stuff_this_time = 0;
 378         my $do_not_wait_on_select = 0;
 379         my ($readyr, $readyw, $written);
 380         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 381                 if (defined $exitwhenstatusmatches) {
 382                         if ($status =~ /$exitwhenstatusmatches/m) {
 383                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 384                                 if ($readwrote_stuff_this_time) {
 385                                         trace("read/write some more\n");
 386                                         $do_not_wait_on_select = 1;
 387                                 } else {
 388                                         trace("that's it in our while loop.\n");
 389                                         last;
 390                                 }
 391                         };
 392                 };
 393
 394                 $readwrote_stuff_this_time = 0;
 395                 trace("select waiting for ".($sout->count())." fds.");
 396                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
 397                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 398                 for my $wfd (@$readyw) {
 399                         $readwrote_stuff_this_time = 1;
 400                         if (length($in) != $offset) {
 401                                 trace("writing to $wfd.");
 402                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 403                                 $offset += $written;
 404                         };
 405                         if ($offset == length($in)) {
 406                                 trace("writing to $wfd done.");
 407                                 unless ($options{'nocloseinput'}) {
 408                                         close $wfd;
 409                                         trace("$wfd closed.");
 410                                 };
 411                                 $sin->remove($wfd);
 412                                 $sin = undef;
 413                         }
 414                 }
 415
 416                 next unless (defined(@$readyr)); # Wait some more.
 417
 418                 for my $rfd (@$readyr) {
 419                         $readwrote_stuff_this_time = 1;
 420                         if ($rfd->eof) {
 421                                 trace("reading from $rfd done.");
 422                                 $sout->remove($rfd);
 423                                 close($rfd);
 424                                 next;
 425                         }
 426                         trace("reading from $rfd.");
 427                         if ($rfd == $stdoutfd) {
 428                                 $stdout .= <$rfd>;
 429                                 trace2("stdout is now $stdout\n================");
 430                                 next;
 431                         }
 432                         if (defined $statusfd && $rfd == $statusfd) {
 433                                 $status .= <$rfd>;
 434                                 trace2("status is now $status\n================");
 435                                 next;
 436                         }
 437                         if ($rfd == $stderrfd) {
 438                                 $stderr .= <$rfd>;
 439                                 trace2("stderr is now $stderr\n================");
 440                                 next;
 441                         }
 442                 }
 443         }
 444         trace("readwrite_gpg done.");
 445         return ($stdout, $stderr, $status);
 446 };
 447
 448 sub ask($$;$$) {
 449         my ($question, $default, $forceyes, $forceno) = @_;
 450         my $answer;
 451         my $yn = $default ? '[Y/n]' : '[y/N]';
 452         while (1) {
 453                 print $question,' ',$yn, ' ';
 454                 if ($forceyes && $forceno) {
 455                         print "$default (from config/command line)\n";
 456                         return $default;
 457                 };
 458                 if ($forceyes) {
 459                         print "YES (from config/command line)\n";
 460                         return 1;
 461                 };
 462                 if ($forceno) {
 463                         print "NO (from config/command line)\n";
 464                         return 0;
 465                 };
 466
 467                 $answer = <STDIN>;
 468                 if (!defined $answer) {
 469                         $OUTPUT_AUTOFLUSH = 1;
 470                         die "\n\n".
 471                             "End of STDIN reached.  Are you using xargs?  Caff wants to read from STDIN,\n".
 472                             "so you can't really use it with xargs.  A patch against caff to read from\n".
 473                             "the terminal would be appreciated.\n".
 474                             "For now instead of   cat keys | xargs caff  do  caff `cat keys`\n";
 475                 };
 476                 chomp $answer;
 477                 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
 478                 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
 479                 sleep 1;
 480         };
 481         my $result = $default;
 482         $result = 1 if $answer =~ /y/i;
 483         $result = 0 if $answer =~ /n/i;
 484         return $result;
 485 };
 486
 487
 488
 489
 490
 491 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 492 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 493 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 494 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 495 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 496
 497 load_config;
 498 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
 499
 500 my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
 501 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
 502
 503 -d $KEYSBASE  || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
 504 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
 505
 506 my $NOW = time;
 507 my  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
 508 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
 509
 510
 511 sub version($) {
 512         my ($fd) = @_;
 513         print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
 514 };
 515
 516 sub usage($$) {
 517         my ($fd, $exitcode) = @_;
 518         version($fd);
 519         print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
 520         print $fd "Consult the manual page for more information.\n";
 521         exit $exitcode;
 522 };
 523
 524 ######
 525 # export key $keyid from $gnupghome
 526 ######
 527 sub export_key($$) {
 528         my ($gnupghome, $keyid) = @_;
 529
 530         my $gpg = GnuPG::Interface->new();
 531         $gpg->call( $CONFIG{'gpg'} );
 532         if (defined $gnupghome) {
 533                 $gpg->options->hash_init(
 534                         'homedir' => $gnupghome,
 535                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 536                         'armor' => 1 );
 537         } else {
 538                 $gpg->options->hash_init(
 539                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 540                         'armor' => 1 );
 541         };
 542         $gpg->options->meta_interactive( 0 );
 543         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 544         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 545         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 546         waitpid $pid, 0;
 547
 548         return $stdout;
 549 };
 550
 551 ######
 552 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
 553 ######
 554 sub import_key($$) {
 555         my ($gnupghome, $asciikey) = @_;
 556
 557         my $gpg = GnuPG::Interface->new();
 558         $gpg->call( $CONFIG{'gpg'} );
 559         $gpg->options->hash_init(
 560                 'homedir' => $gnupghome,
 561                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] );
 562         $gpg->options->meta_interactive( 0 );
 563         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 564         my $pid = $gpg->import_keys(handles => $handles);
 565         my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 566         waitpid $pid, 0;
 567
 568         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 569                 return undef;
 570         };
 571         return 1;
 572 };
 573
 574
 575 ######
 576 # Send an email to $address.  If $can_encrypt is true then the mail
 577 # will be PGP/MIME encrypted to $longkeyid.
 578 #
 579 # $longkeyid, $uid, and @attached will be used in the email and the template.
 580 ######
 581 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 582 sub send_mail($$$@) {
 583         my ($address, $can_encrypt, $key_id, @keys) = @_;
 584
 585         my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
 586             or die "Error creating template: $Text::Template::ERROR";
 587
 588         my @uids;
 589         for my $key (@keys) {
 590             push @uids, $key->{'text'};
 591         };
 592         my $message = $template->fill_in(HASH => { key => $key_id,
 593                                                    uids => \@uids,
 594                                                    owner => $CONFIG{'owner'}})
 595             or die "Error filling template in: $Text::Template::ERROR";
 596
 597         my $message_entity = MIME::Entity->build(
 598                 Type        => "text/plain",
 599                 Charset     => "utf-8",
 600                 Disposition => 'inline',
 601                 Data        => $message);
 602
 603         my @key_entities;
 604         for my $key (@keys) {
 605                 $message_entity->attach(
 606                         Type        => "application/pgp-keys",
 607                         Disposition => 'attachment',
 608                         Encoding    => "7bit",
 609                         Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
 610                         Data        => $key->{'key'},
 611                         Filename    => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
 612         };
 613
 614         if ($can_encrypt) {
 615                 my $message = $message_entity->stringify();
 616
 617                 my $gpg = GnuPG::Interface->new();
 618                 $gpg->call( $CONFIG{'gpg'} );
 619                 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
 620                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 621                         'armor' => 1 );
 622                 $gpg->options->meta_interactive( 0 );
 623                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 624                 $gpg->options->push_recipients( $key_id );
 625                 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
 626                 my $pid = $gpg->encrypt(handles => $handles);
 627                 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 628                 waitpid $pid, 0;
 629                 if ($stdout eq '') {
 630                         warn ("No data from gpg for list-key $key_id\n");
 631                         next;
 632                 };
 633                 $message = $stdout;
 634
 635                 $message_entity = MIME::Entity->build(
 636                         Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');
 637
 638                 $message_entity->attach(
 639                         Type        => "application/pgp-encrypted",
 640                         Disposition => 'attachment',
 641                         Encoding    => "7bit",
 642                         Data        => "Version: 1\n");
 643
 644                 $message_entity->attach(
 645                         Type        => "application/octet-stream",
 646                         Filename    => 'msg.asc',
 647                         Disposition => 'inline',
 648                         Encoding    => "7bit",
 649                         Data        => $message);
 650         };
 651
 652         $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
 653         $message_entity->head->add("To", $address);
 654         $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
 655         $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
 656         $message_entity->head->add("User-Agent", $USER_AGENT);
 657         $message_entity->send();
 658         $message_entity->stringify();
 659 };
 660
 661 ######
 662 # clean up a UID so that it can be used on the FS.
 663 ######
 664 sub sanitize_uid($) {
 665         my ($uid) = @_;
 666
 667         my $good_uid = $uid;
 668         $good_uid =~ tr#/:\\#_#;
 669         trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
 670         return $good_uid;
 671 };
 672
 673 sub delete_signatures($$$$$$) {
 674         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
 675
 676         my $signed_by_me = 0;
 677
 678         my ($stdout, $stderr, $status) =
 679                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 680
 681         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 682                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 683                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 684                 $stdout =~ s/\n/\\n/g;
 685                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 686                 my $line = pop @sigline;
 687                 my $answer = "no";
 688                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 689                         debug("[sigremoval] doing line $line.");
 690                         my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
 691                         if ($signer eq $longkeyid) {
 692                                 debug("[sigremoval] selfsig ($signer).");
 693                                 $answer = "no";
 694                         } elsif (grep { $signer eq $_ } @{$keyids}) {
 695                                 debug("[sigremoval] signed by us ($signer).");
 696                                 $answer = "no";
 697                                 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 698                         } else {
 699                                 debug("[sigremoval] not interested in that sig ($signer).");
 700                                 $answer = "yes";
 701                         };
 702                 } else {
 703                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 704                 };
 705                 ($stdout, $stderr, $status) =
 706                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 707         };
 708
 709         return $signed_by_me;
 710 };
 711
 712
 713
 714 my $USER;
 715 my @KEYIDS;
 716 my $params;
 717
 718 Getopt::Long::config('bundling');
 719 if (!GetOptions (
 720         '-h'              =>  \$params->{'help'},
 721         '--help'          =>  \$params->{'help'},
 722         '--version'       =>  \$params->{'version'},
 723         '-V'              =>  \$params->{'version'},
 724         '-u=s'            =>  \$params->{'local-user'},
 725         '--local-user=s'  =>  \$params->{'local-user'},
 726         '-e'              =>  \$params->{'export-old'},
 727         '--export-old'    =>  \$params->{'export-old'},
 728         '-E'              =>  \$params->{'no-export-old'},
 729         '--no-export-old' =>  \$params->{'no-export-old'},
 730         '-m'              =>  \$params->{'mail'},
 731         '--mail'          =>  \$params->{'mail'},
 732         '-M'              =>  \$params->{'no-mail'},
 733         '--no-mail'       =>  \$params->{'no-mail'},
 734         '-R'              =>  \$params->{'no-download'},
 735         '--no-download'   =>  \$params->{'no-download'},
 736         '-S'              =>  \$params->{'no-sign'},
 737         '--no-sign'       =>  \$params->{'no-sign'},
 738         '--key-file=s@'   =>  \$params->{'key-files'},
 739         )) {
 740         usage(\*STDERR, 1);
 741 };
 742 if ($params->{'help'}) {
 743         usage(\*STDOUT, 0);
 744 };
 745 if ($params->{'version'}) {
 746         version(\*STDOUT);
 747         exit(0);
 748 };
 749 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
 750
 751
 752
 753 if ($params->{'local-user'}) {
 754         $USER = $params->{'local-user'};
 755         $USER =~ s/^0x//i;
 756         unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
 757                 print STDERR "-u $USER is not a keyid.\n";
 758                 usage(\*STDERR, 1);
 759         };
 760         $USER = uc($USER);
 761 };
 762
 763 for my $keyid (@ARGV) {
 764         $keyid =~ s/^0x//i;
 765         unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
 766                 if ($keyid =~ /^[A-F0-9]{32}$/) {
 767                         info("Ignoring v3 fingerprint $keyid.  v3 keys are obsolete.");
 768                         next;
 769                 };
 770                 print STDERR "$keyid is not a keyid.\n";
 771                 usage(\*STDERR, 1);
 772         };
 773         push @KEYIDS, uc($keyid);
 774 };
 775
 776 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
 777 $CONFIG{'no-mail'}     = $params->{'no-mail'}     if defined $params->{'no-mail'};
 778 $CONFIG{'mail'}        = $params->{'mail'}        if defined $params->{'mail'};
 779 $CONFIG{'no-sign'}     = $params->{'no-sign'}     if defined $params->{'no-sign'};
 780 push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'};
 781
 782
 783 #################
 784 # import own keys
 785 #################
 786 for my $keyid (@{$CONFIG{'keyid'}}) {
 787         my $gpg = GnuPG::Interface->new();
 788         $gpg->call( $CONFIG{'gpg'} );
 789         $gpg->options->hash_init(
 790                 'homedir' => $GNUPGHOME,
 791                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --fast-list-mode } ] );
 792         $gpg->options->meta_interactive( 0 );
 793         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 794         my $pid = $gpg->list_public_keys(handles => $handles, command_args => $keyid);
 795         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 796         waitpid $pid, 0;
 797
 798         if ($stdout eq '') {
 799                 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
 800         };
 801         unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
 802                 info("Key $keyid not found in caff's home.  Getting it from your normal GnuPGHome.");
 803                 my $key = export_key(undef, $keyid);
 804                 if (!defined $key || $key eq '') {
 805                         warn ("Did not get key $keyid from your normal GnuPGHome\n");
 806                         next;
 807                 };
 808                 my $result = import_key($GNUPGHOME, $key);
 809                 unless ($result) {
 810                         warn ("Could not import $keyid into caff's gnupghome.\n");
 811                         next;
 812                 };
 813         }
 814 }
 815
 816 ########################
 817 # import keys from files
 818 ########################
 819 foreach my $keyfile (@{$CONFIG{'key-files'}}) {
 820     my $gpg = GnuPG::Interface->new();
 821     $gpg->call( $CONFIG{'gpg'} );
 822     $gpg->options->hash_init('homedir' => $GNUPGHOME);
 823     $gpg->options->meta_interactive( 0 );
 824     my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 825     my $pid = $gpg->import_keys(handles => $handles, command_args => $keyfile);
 826     my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 827     info ("Importing keys from $keyfile");
 828     waitpid $pid, 0;
 829     if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 830         warn $stderr;
 831     }
 832 }
 833
 834 #############################
 835 # receive keys from keyserver
 836 #############################
 837 my @keyids_ok;
 838 if ($CONFIG{'no-download'}) {
 839         @keyids_ok = @KEYIDS;
 840 } else {
 841         info ("fetching keys, this will take a while...");
 842
 843         my $gpg = GnuPG::Interface->new();
 844         $gpg->call( $CONFIG{'gpg'} );
 845         $gpg->options->hash_init(
 846                 'homedir' => $GNUPGHOME,
 847                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
 848         $gpg->options->meta_interactive( 0 );
 849         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 850         my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
 851         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 852         waitpid $pid, 0;
 853
 854 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 855 # [GNUPG:] NODATA 1
 856 # [GNUPG:] NODATA 1
 857 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 858         my %local_keyids = map { $_ => 1 } @KEYIDS;
 859         for my $line (split /\n/, $status) {
 860                 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
 861                         my $imported_key = $1;
 862                         my $whole_fpr = $imported_key;
 863                         my $long_keyid = substr($imported_key, -16);
 864                         my $short_keyid = substr($imported_key, -8);
 865                         my $speced_key;
 866                         for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
 867                                 $speced_key = $spec if $local_keyids{$spec};
 868                         };
 869                         unless ($speced_key) {
 870                             notice ("Imported unexpected key; got: $imported_key\n");
 871                             next;
 872                         };
 873                         debug ("Imported $imported_key for $speced_key");
 874                         delete $local_keyids{$speced_key};
 875                         unshift @keyids_ok, $imported_key;
 876                 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
 877                 } else {
 878                         notice ("got unknown reply from gpg: $line");
 879                 }
 880         };
 881         if (scalar %local_keyids) {
 882                 notice ("Import failed for: ". (join ' ', keys %local_keyids).".");
 883                 exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
 884         }
 885 };
 886
 887 unless (@keyids_ok) {
 888         notice ("No keys to sign found");
 889         exit 0;
 890 }
 891
 892 ###########
 893 # sign keys
 894 ###########
 895 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
 896         $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
 897 }
 898
 899 unless ($CONFIG{'no-sign'}) {
 900         info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
 901         for my $keyid (@keyids_ok) {
 902                 my @command;
 903                 push @command, $CONFIG{'gpg-sign'};
 904                 push @command, '--local-user', $USER if (defined $USER);
 905                 push @command, "--homedir=$GNUPGHOME";
 906                 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 907                 push @command, '--no-auto-check-trustdb';
 908                 push @command, '--trust-model=always';
 909                 push @command, '--edit', $keyid;
 910                 push @command, 'sign';
 911                 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
 912                 print join(' ', @command),"\n";
 913                 system (@command);
 914         };
 915 };
 916
 917 ##################
 918 # export and prune
 919 ##################
 920 KEYS:
 921 for my $keyid (@keyids_ok) {
 922         # get key listing
 923         #################
 924         my $gpg = GnuPG::Interface->new();
 925         $gpg->call( $CONFIG{'gpg'} );
 926         $gpg->options->hash_init(
 927                 'homedir' => $GNUPGHOME,
 928                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
 929         $gpg->options->meta_interactive( 0 );
 930         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 931         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 932         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 933         waitpid $pid, 0;
 934         if ($stdout eq '') {
 935                 warn ("No data from gpg for list-key $keyid\n");
 936                 next;
 937         };
 938         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 939         if (scalar @publine == 0) {
 940                 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
 941                 next;
 942         };
 943         my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 944         if (scalar @publine > 0) {
 945                 warn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint\n");
 946                 next;
 947         };
 948         unless (defined $longkeyid) {
 949                 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
 950                 next;
 951         };
 952         unless (defined $flags) {
 953                 warn ("Didn't find flags in --list-key of key $keyid.\n");
 954                 next;
 955         };
 956         my $can_encrypt = $flags =~ /E/;
 957
 958         # export the key
 959         ################
 960         my $asciikey = export_key($GNUPGHOME, $keyid);
 961         if ($asciikey eq '') {
 962                 warn ("No data from gpg for export $keyid\n");
 963                 next;
 964         };
 965
 966         my @UIDS;
 967         my $uid_number = 0;
 968         while (1) {
 969                 my $this_uid_text = '';
 970                 $uid_number++;
 971                 debug("Doing key $keyid, uid $uid_number");
 972                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 973
 974                 # import into temporary gpghome
 975                 ###############################
 976                 my $result = import_key($tempdir, $asciikey);
 977                 unless ($result) {
 978                         warn ("Could not import $keyid into temporary gnupg.\n");
 979                         next;
 980                 };
 981
 982                 # prune it
 983                 ##########
 984                 $gpg = GnuPG::Interface->new();
 985                 $gpg->call( $CONFIG{'gpg-delsig'} );
 986                 $gpg->options->hash_init(
 987                         'homedir' => $tempdir,
 988                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
 989                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 990                 $pid = $gpg->wrap_call(
 991                         commands     => [ '--edit' ],
 992                         command_args => [ $keyid ],
 993                         handles      => $handles );
 994
 995                 debug("Starting edit session");
 996                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 997
 998                 # delete other uids
 999                 ###################
1000                 my $number_of_subkeys = 0;
1001                 my $i = 1;
1002                 my $have_one = 0;
1003                 my $is_uat = 0;
1004                 my $delete_some = 0;
1005                 debug("Parsing stdout output.");
1006                 for my $line (split /\n/, $stdout) {
1007                         debug("Checking line $line");
1008                         my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1009                         if ($type eq 'sub') {
1010                                 $number_of_subkeys++;
1011                         };
1012                         next unless ($type eq 'uid' || $type eq 'uat');
1013                         debug("line is interesting.");
1014                         if ($uid_number != $i) {
1015                                 debug("mark for deletion.");
1016                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1017                                 $delete_some++;
1018                         } else {
1019                                 debug("keep it.");
1020                                 $have_one = 1;
1021                                 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
1022                                 $is_uat = $type eq 'uat';
1023                         };
1024                         $i++;
1025                 };
1026                 debug("Parsing stdout output done.");
1027                 unless ($have_one) {
1028                         debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1029                         info("key $keyid done.");
1030                         last;
1031                 };
1032
1033                 my $prune_some_sigs_on_uid;
1034                 my $prune_all_sigs_on_uid;
1035                 if ($is_uat) {
1036                         debug("handling attribute userid of key $keyid.");
1037                         if ($uid_number == 1) {
1038                                 debug(" attribute userid is #1, unmarking #2 for deletion.");
1039                                 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1040                                 $delete_some--;
1041                                 $prune_some_sigs_on_uid = 1;
1042                                 $prune_all_sigs_on_uid = 2;
1043                         } else {
1044                                 debug("attribute userid is not #1, unmarking #1 for deletion.");
1045                                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1046                                 $delete_some--;
1047                                 $prune_some_sigs_on_uid = 2;
1048                                 $prune_all_sigs_on_uid = 1;
1049                         };
1050                 } else {
1051                         $prune_some_sigs_on_uid = 1;
1052                 };
1053
1054                 if ($delete_some) {
1055                         debug("need to delete $delete_some uids.");
1056                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
1057                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1058                 };
1059
1060                 # delete subkeys
1061                 ################
1062                 if ($number_of_subkeys > 0) {
1063                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
1064                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1065                         };
1066                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
1067                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1068                 };
1069
1070                 # delete signatures
1071                 ###################
1072                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1073                 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1074                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1075                 if (defined $prune_all_sigs_on_uid) {
1076                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1077                         delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1078                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1079                 };
1080
1081
1082                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1083                 waitpid $pid, 0;
1084
1085                 my $asciikey = export_key($tempdir, $keyid);
1086                 if ($asciikey eq '') {
1087                         warn ("No data from gpg for export $keyid\n");
1088                         next;
1089                 };
1090
1091                 if ($signed_by_me) {
1092                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1093                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1094                                 next unless $write;
1095                         };
1096                         my $keydir = "$KEYSBASE/$DATE_STRING";
1097                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1098
1099                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1100                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1101                         print KEY $asciikey;
1102                         close KEY;
1103
1104                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
1105
1106                         info("$longkeyid $uid_number $this_uid_text done.");
1107                 } else {
1108                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1109                 };
1110         };
1111
1112         if (scalar @UIDS == 0) {
1113                 info("found no signed uids for $keyid");
1114         } else {
1115                 next if $CONFIG{'no-mail'}; # do not send mail
1116
1117                 my @attached;
1118                 for my $uid (@UIDS) {
1119                         trace("UID: $uid->{'text'}\n");
1120                         if ($uid->{'is_uat'}) {
1121                                 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1122                                 push @attached, $uid if $attach;
1123                         } elsif ($uid->{'text'} !~ /@/) {
1124                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1125                                 push @attached, $uid if $attach;
1126                         };
1127                 };
1128
1129                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1130                 for my $uid (@UIDS) {
1131                         if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1132                                 my $address = $uid->{'text'};
1133                                 $address =~ s/.*<(.*)>.*/$1/;
1134                                 if (ask("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1135                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1136
1137                                         my $keydir = "$KEYSBASE/$DATE_STRING";
1138                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1139                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1140                                         print KEY $mail;
1141                                         close KEY;
1142                                 };
1143                         };
1144                 };
1145         };
1146
1147 };