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         my $answer;
 442         while (1) {
 443                 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
 444                 if ($forceyes && $forceno) {
 445                         print "$default (from config/command line)\n";
 446                         return $default;
 447                 };
 448                 if ($forceyes) {
 449                         print "YES (from config/command line)\n";
 450                         return 1;
 451                 };
 452                 if ($forceno) {
 453                         print "NO (from config/command line)\n";
 454                         return 0;
 455                 };
 456
 457                 $answer = <STDIN>;
 458                 chomp $answer;
 459                 last if ((defined $answer) && (length $answer <= 1));
 460                 print "grrrrrr.\n";
 461                 sleep 1;
 462         };
 463         my $result = $default;
 464         $result = 1 if $answer =~ /y/i;
 465         $result = 0 if $answer =~ /n/i;
 466         return $result;
 467 };
 468
 469
 470
 471
 472
 473 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 474 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 475 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 476 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 477 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 478
 479 load_config;
 480 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
 481
 482 my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
 483 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
 484
 485 -d $KEYSBASE  || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
 486 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
 487
 488 my $NOW = time;
 489 my  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
 490 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
 491
 492
 493 sub version($) {
 494         my ($fd) = @_;
 495         print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
 496 };
 497
 498 sub usage($$) {
 499         my ($fd, $exitcode) = @_;
 500         version($fd);
 501         print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
 502         print $fd "Consult the manual page for more information.\n";
 503         exit $exitcode;
 504 };
 505
 506 ######
 507 # export key $keyid from $gnupghome
 508 ######
 509 sub export_key($$) {
 510         my ($gnupghome, $keyid) = @_;
 511
 512         my $gpg = GnuPG::Interface->new();
 513         $gpg->call( $CONFIG{'gpg'} );
 514         if (defined $gnupghome) {
 515                 $gpg->options->hash_init(
 516                         'homedir' => $gnupghome,
 517                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 518                         'armor' => 1 );
 519         } else {
 520                 $gpg->options->hash_init(
 521                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 522                         'armor' => 1 );
 523         };
 524         $gpg->options->meta_interactive( 0 );
 525         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 526         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 527         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 528         waitpid $pid, 0;
 529
 530         return $stdout;
 531 };
 532
 533 ######
 534 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
 535 ######
 536 sub import_key($$) {
 537         my ($gnupghome, $asciikey) = @_;
 538
 539         my $gpg = GnuPG::Interface->new();
 540         $gpg->call( $CONFIG{'gpg'} );
 541         $gpg->options->hash_init(
 542                 'homedir' => $gnupghome,
 543                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] );
 544         $gpg->options->meta_interactive( 0 );
 545         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 546         my $pid = $gpg->import_keys(handles => $handles);
 547         my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 548         waitpid $pid, 0;
 549
 550         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 551                 return undef;
 552         };
 553         return 1;
 554 };
 555
 556
 557 ######
 558 # Send an email to $address.  If $can_encrypt is true then the mail
 559 # will be PGP/MIME encrypted to $longkeyid.
 560 #
 561 # $longkeyid, $uid, and @attached will be used in the email and the template.
 562 ######
 563 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 564 sub send_mail($$$@) {
 565         my ($address, $can_encrypt, $key_id, @keys) = @_;
 566
 567         my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
 568             or die "Error creating template: $Text::Template::ERROR";
 569
 570         my @uids;
 571         for my $key (@keys) {
 572             push @uids, $key->{'text'};
 573         };
 574         my $message = $template->fill_in(HASH => { key => $key_id,
 575                                                    uids => \@uids,
 576                                                    owner => $CONFIG{'owner'}})
 577             or die "Error filling template in: $Text::Template::ERROR";
 578
 579         my $message_entity = MIME::Entity->build(
 580                 Type        => "text/plain",
 581                 Charset     => "utf-8",
 582                 Disposition => 'inline',
 583                 Data        => $message);
 584
 585         my @key_entities;
 586         for my $key (@keys) {
 587                 $message_entity->attach(
 588                         Type        => "application/pgp-keys",
 589                         Disposition => 'attachment',
 590                         Encoding    => "7bit",
 591                         Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
 592                         Data        => $key->{'key'},
 593                         Filename    => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
 594         };
 595
 596         if ($can_encrypt) {
 597                 my $message = $message_entity->stringify();
 598
 599                 my $gpg = GnuPG::Interface->new();
 600                 $gpg->call( $CONFIG{'gpg'} );
 601                 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
 602                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
 603                         'armor' => 1 );
 604                 $gpg->options->meta_interactive( 0 );
 605                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 606                 $gpg->options->push_recipients( $key_id );
 607                 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
 608                 my $pid = $gpg->encrypt(handles => $handles);
 609                 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 610                 waitpid $pid, 0;
 611                 if ($stdout eq '') {
 612                         warn ("No data from gpg for list-key $key_id\n");
 613                         next;
 614                 };
 615                 $message = $stdout;
 616
 617                 $message_entity = MIME::Entity->build(
 618                         Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');
 619
 620                 $message_entity->attach(
 621                         Type        => "application/pgp-encrypted",
 622                         Disposition => 'attachment',
 623                         Encoding    => "7bit",
 624                         Data        => "Version: 1\n");
 625
 626                 $message_entity->attach(
 627                         Type        => "application/octet-stream",
 628                         Filename    => 'msg.asc',
 629                         Disposition => 'inline',
 630                         Encoding    => "7bit",
 631                         Data        => $message);
 632         };
 633
 634         $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
 635         $message_entity->head->add("To", $address);
 636         $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
 637         $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
 638         $message_entity->head->add("User-Agent", $USER_AGENT);
 639         $message_entity->send();
 640         $message_entity->stringify();
 641 };
 642
 643 ######
 644 # clean up a UID so that it can be used on the FS.
 645 ######
 646 sub sanitize_uid($) {
 647         my ($uid) = @_;
 648
 649         my $good_uid = $uid;
 650         $good_uid =~ tr#/:\\#_#;
 651         trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
 652         return $good_uid;
 653 };
 654
 655 sub delete_signatures($$$$$$) {
 656         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
 657
 658         my $signed_by_me = 0;
 659
 660         my ($stdout, $stderr, $status) =
 661                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 662
 663         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 664                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 665                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 666                 $stdout =~ s/\n/\\n/g;
 667                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 668                 my $line = pop @sigline;
 669                 my $answer = "no";
 670                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 671                         debug("[sigremoval] doing line $line.");
 672                         my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
 673                         if ($signer eq $longkeyid) {
 674                                 debug("[sigremoval] selfsig ($signer).");
 675                                 $answer = "no";
 676                         } elsif (grep { $signer eq $_ } @{$keyids}) {
 677                                 debug("[sigremoval] signed by us ($signer).");
 678                                 $answer = "no";
 679                                 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 680                         } else {
 681                                 debug("[sigremoval] not interested in that sig ($signer).");
 682                                 $answer = "yes";
 683                         };
 684                 } else {
 685                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 686                 };
 687                 ($stdout, $stderr, $status) =
 688                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 689         };
 690
 691         return $signed_by_me;
 692 };
 693
 694
 695
 696 my $USER;
 697 my @KEYIDS;
 698 my $params;
 699
 700 Getopt::Long::config('bundling');
 701 if (!GetOptions (
 702         '-h'              =>  \$params->{'help'},
 703         '--help'          =>  \$params->{'help'},
 704         '--version'       =>  \$params->{'version'},
 705         '-V'              =>  \$params->{'version'},
 706         '-u=s'            =>  \$params->{'local-user'},
 707         '--local-user=s'  =>  \$params->{'local-user'},
 708         '-e'              =>  \$params->{'export-old'},
 709         '--export-old'    =>  \$params->{'export-old'},
 710         '-E'              =>  \$params->{'no-export-old'},
 711         '--no-export-old' =>  \$params->{'no-export-old'},
 712         '-m'              =>  \$params->{'mail'},
 713         '--mail'          =>  \$params->{'mail'},
 714         '-M'              =>  \$params->{'no-mail'},
 715         '--no-mail'       =>  \$params->{'no-mail'},
 716         '-R'              =>  \$params->{'no-download'},
 717         '--no-download'   =>  \$params->{'no-download'},
 718         '-S'              =>  \$params->{'no-sign'},
 719         '--no-sign'       =>  \$params->{'no-sign'},
 720         )) {
 721         usage(\*STDERR, 1);
 722 };
 723 if ($params->{'help'}) {
 724         usage(\*STDOUT, 0);
 725 };
 726 if ($params->{'version'}) {
 727         version(\*STDOUT);
 728         exit(0);
 729 };
 730 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
 731
 732
 733
 734 if ($params->{'local-user'}) {
 735         $USER = $params->{'local-user'};
 736         $USER =~ s/^0x//i;
 737         unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
 738                 print STDERR "-u $USER is not a keyid.\n";
 739                 usage(\*STDERR, 1);
 740         };
 741         $USER = uc($USER);
 742 };
 743
 744 for my $keyid (@ARGV) {
 745         $keyid =~ s/^0x//i;
 746         unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
 747                 if ($keyid =~ /^[A-F0-9]{32}$/) {
 748                         info("Ignoring v3 fingerprint $keyid.  v3 keys are obsolete.");
 749                         next;
 750                 };
 751                 print STDERR "$keyid is not a keyid.\n";
 752                 usage(\*STDERR, 1);
 753         };
 754         push @KEYIDS, uc($keyid);
 755 };
 756
 757 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
 758 $CONFIG{'no-mail'}     = $params->{'no-mail'}     if defined $params->{'no-mail'};
 759 $CONFIG{'mail'}        = $params->{'mail'}        if defined $params->{'mail'};
 760 $CONFIG{'no-sign'}     = $params->{'no-sign'}     if defined $params->{'no-sign'};
 761
 762
 763 #################
 764 # import own keys
 765 #################
 766 for my $keyid (@{$CONFIG{'keyid'}}) {
 767         my $gpg = GnuPG::Interface->new();
 768         $gpg->call( $CONFIG{'gpg'} );
 769         $gpg->options->hash_init(
 770                 'homedir' => $GNUPGHOME,
 771                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --fast-list-mode } ] );
 772         $gpg->options->meta_interactive( 0 );
 773         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 774         my $pid = $gpg->list_public_keys(handles => $handles, command_args => $keyid);
 775         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 776         waitpid $pid, 0;
 777
 778         if ($stdout eq '') {
 779                 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
 780         };
 781         unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
 782                 info("Key $keyid not found in caff's home.  Getting it from your normal GnuPGHome.");
 783                 my $key = export_key(undef, $keyid);
 784                 if (!defined $key || $key eq '') {
 785                         warn ("Did not get key $keyid from your normal GnuPGHome\n");
 786                         next;
 787                 };
 788                 my $result = import_key($GNUPGHOME, $key);
 789                 unless ($result) {
 790                         warn ("Could not import $keyid into caff's gnupghome.\n");
 791                         next;
 792                 };
 793         }
 794 }
 795
 796 #############################
 797 # receive keys from keyserver
 798 #############################
 799 my @keyids_ok;
 800 if ($CONFIG{'no-download'}) {
 801         @keyids_ok = @KEYIDS;
 802 } else {
 803         info ("fetching keys, this will take a while...");
 804
 805         my $gpg = GnuPG::Interface->new();
 806         $gpg->call( $CONFIG{'gpg'} );
 807         $gpg->options->hash_init(
 808                 'homedir' => $GNUPGHOME,
 809                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
 810         $gpg->options->meta_interactive( 0 );
 811         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 812         my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
 813         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 814         waitpid $pid, 0;
 815
 816 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 817 # [GNUPG:] NODATA 1
 818 # [GNUPG:] NODATA 1
 819 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 820         my %local_keyids = map { $_ => 1 } @KEYIDS;
 821         for my $line (split /\n/, $status) {
 822                 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
 823                         my $imported_key = $1;
 824                         my $whole_fpr = $imported_key;
 825                         my $long_keyid = substr($imported_key, -16);
 826                         my $short_keyid = substr($imported_key, -8);
 827                         my $speced_key;
 828                         for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
 829                                 $speced_key = $spec if $local_keyids{$spec};
 830                         };
 831                         unless ($speced_key) {
 832                             notice ("Imported unexpected key; got: $imported_key\n");
 833                             next;
 834                         };
 835                         debug ("Imported $imported_key for $speced_key");
 836                         delete $local_keyids{$speced_key};
 837                         unshift @keyids_ok, $imported_key;
 838                 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
 839                 } else {
 840                         notice ("got unknown reply from gpg: $line");
 841                 }
 842         };
 843         if (scalar %local_keyids) {
 844                 notice ("Import failed for: ". (join ' ', keys %local_keyids).".");
 845                 exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
 846         }
 847 };
 848
 849 unless (@keyids_ok) {
 850         notice ("No keys to sign found");
 851         exit 0;
 852 }
 853
 854 ###########
 855 # sign keys
 856 ###########
 857 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
 858         $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
 859 }
 860
 861 unless ($CONFIG{'no-sign'}) {
 862         info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
 863         for my $keyid (@keyids_ok) {
 864                 my @command;
 865                 push @command, $CONFIG{'gpg-sign'};
 866                 push @command, '--local-user', $USER if (defined $USER);
 867                 push @command, "--homedir=$GNUPGHOME";
 868                 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 869                 push @command, '--no-auto-check-trustdb';
 870                 push @command, '--trust-model=always';
 871                 push @command, '--edit', $keyid;
 872                 push @command, 'sign';
 873                 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
 874                 print join(' ', @command),"\n";
 875                 system (@command);
 876         };
 877 };
 878
 879 ##################
 880 # export and prune
 881 ##################
 882 KEYS:
 883 for my $keyid (@keyids_ok) {
 884         # get key listing
 885         #################
 886         my $gpg = GnuPG::Interface->new();
 887         $gpg->call( $CONFIG{'gpg'} );
 888         $gpg->options->hash_init(
 889                 'homedir' => $GNUPGHOME,
 890                 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
 891         $gpg->options->meta_interactive( 0 );
 892         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 893         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 894         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 895         waitpid $pid, 0;
 896         if ($stdout eq '') {
 897                 warn ("No data from gpg for list-key $keyid\n");
 898                 next;
 899         };
 900         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 901         if (scalar @publine == 0) {
 902                 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
 903                 next;
 904         };
 905         my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 906         if (scalar @publine > 0) {
 907                 warn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint\n");
 908                 next;
 909         };
 910         unless (defined $longkeyid) {
 911                 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
 912                 next;
 913         };
 914         unless (defined $flags) {
 915                 warn ("Didn't find flags in --list-key of key $keyid.\n");
 916                 next;
 917         };
 918         my $can_encrypt = $flags =~ /E/;
 919
 920         # export the key
 921         ################
 922         my $asciikey = export_key($GNUPGHOME, $keyid);
 923         if ($asciikey eq '') {
 924                 warn ("No data from gpg for export $keyid\n");
 925                 next;
 926         };
 927
 928         my @UIDS;
 929         my $uid_number = 0;
 930         while (1) {
 931                 my $this_uid_text = '';
 932                 $uid_number++;
 933                 debug("Doing key $keyid, uid $uid_number");
 934                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 935
 936                 # import into temporary gpghome
 937                 ###############################
 938                 my $result = import_key($tempdir, $asciikey);
 939                 unless ($result) {
 940                         warn ("Could not import $keyid into temporary gnupg.\n");
 941                         next;
 942                 };
 943
 944                 # prune it
 945                 ##########
 946                 $gpg = GnuPG::Interface->new();
 947                 $gpg->call( $CONFIG{'gpg-delsig'} );
 948                 $gpg->options->hash_init(
 949                         'homedir' => $tempdir,
 950                         'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
 951                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 952                 $pid = $gpg->wrap_call(
 953                         commands     => [ '--edit' ],
 954                         command_args => [ $keyid ],
 955                         handles      => $handles );
 956
 957                 debug("Starting edit session");
 958                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 959
 960                 # delete other uids
 961                 ###################
 962                 my $number_of_subkeys = 0;
 963                 my $i = 1;
 964                 my $have_one = 0;
 965                 my $is_uat = 0;
 966                 my $delete_some = 0;
 967                 debug("Parsing stdout output.");
 968                 for my $line (split /\n/, $stdout) {
 969                         debug("Checking line $line");
 970                         my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
 971                         if ($type eq 'sub') {
 972                                 $number_of_subkeys++;
 973                         };
 974                         next unless ($type eq 'uid' || $type eq 'uat');
 975                         debug("line is interesting.");
 976                         if ($uid_number != $i) {
 977                                 debug("mark for deletion.");
 978                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 979                                 $delete_some++;
 980                         } else {
 981                                 debug("keep it.");
 982                                 $have_one = 1;
 983                                 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
 984                                 $is_uat = $type eq 'uat';
 985                         };
 986                         $i++;
 987                 };
 988                 debug("Parsing stdout output done.");
 989                 unless ($have_one) {
 990                         debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
 991                         info("key $keyid done.");
 992                         last;
 993                 };
 994
 995                 my $prune_some_sigs_on_uid;
 996                 my $prune_all_sigs_on_uid;
 997                 if ($is_uat) {
 998                         debug("handling attribute userid of key $keyid.");
 999                         if ($uid_number == 1) {
1000                                 debug(" attribute userid is #1, unmarking #2 for deletion.");
1001                                 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1002                                 $delete_some--;
1003                                 $prune_some_sigs_on_uid = 1;
1004                                 $prune_all_sigs_on_uid = 2;
1005                         } else {
1006                                 debug("attribute userid is not #1, unmarking #1 for deletion.");
1007                                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1008                                 $delete_some--;
1009                                 $prune_some_sigs_on_uid = 2;
1010                                 $prune_all_sigs_on_uid = 1;
1011                         };
1012                 } else {
1013                         $prune_some_sigs_on_uid = 1;
1014                 };
1015
1016                 if ($delete_some) {
1017                         debug("need to delete $delete_some uids.");
1018                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
1019                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1020                 };
1021
1022                 # delete subkeys
1023                 ################
1024                 if ($number_of_subkeys > 0) {
1025                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
1026                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1027                         };
1028                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
1029                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1030                 };
1031
1032                 # delete signatures
1033                 ###################
1034                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1035                 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1036                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1037                 if (defined $prune_all_sigs_on_uid) {
1038                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1039                         delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1040                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1041                 };
1042
1043
1044                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1045                 waitpid $pid, 0;
1046
1047                 my $asciikey = export_key($tempdir, $keyid);
1048                 if ($asciikey eq '') {
1049                         warn ("No data from gpg for export $keyid\n");
1050                         next;
1051                 };
1052
1053                 if ($signed_by_me) {
1054                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1055                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1056                                 next unless $write;
1057                         };
1058                         my $keydir = "$KEYSBASE/$DATE_STRING";
1059                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1060
1061                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1062                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1063                         print KEY $asciikey;
1064                         close KEY;
1065
1066                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
1067
1068                         info("$longkeyid $uid_number $this_uid_text done.");
1069                 } else {
1070                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1071                 };
1072         };
1073
1074         if (scalar @UIDS == 0) {
1075                 info("found no signed uids for $keyid");
1076         } else {
1077                 next if $CONFIG{'no-mail'}; # do not send mail
1078
1079                 my @attached;
1080                 for my $uid (@UIDS) {
1081                         trace("UID: $uid->{'text'}\n");
1082                         if ($uid->{'is_uat'}) {
1083                                 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1084                                 push @attached, $uid if $attach;
1085                         } elsif ($uid->{'text'} !~ /@/) {
1086                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1087                                 push @attached, $uid if $attach;
1088                         };
1089                 };
1090
1091                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1092                 for my $uid (@UIDS) {
1093                         if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1094                                 my $address = $uid->{'text'};
1095                                 $address =~ s/.*<(.*)>.*/$1/;
1096                                 if (ask("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1097                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1098
1099                                         my $keydir = "$KEYSBASE/$DATE_STRING";
1100                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1101                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1102                                         print KEY $mail;
1103                                         close KEY;
1104                                 };
1105                         };
1106                 };
1107         };
1108
1109 };