caff/caff

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