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