caff/caff

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