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 ######
 437 # export key $keyid from $gnupghome
 438 ######
 439 sub export_key($$) {
 440         my ($gnupghome, $keyid) = @_;
 441
 442         my $gpg = GnuPG::Interface->new();
 443         $gpg->call( $CONFIG{'gpg'} );
 444         $gpg->options->hash_init(
 445                 'homedir' => $gnupghome,
 446                 'armor' => 1 );
 447         $gpg->options->meta_interactive( 0 );
 448         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 449         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 450         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 451         waitpid $pid, 0;
 452
 453         return $stdout;
 454 };
 455
 456 ######
 457 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
 458 ######
 459 sub import_key($$) {
 460         ($gnupghome, $asciikey) = @_;
 461
 462         my $gpg = GnuPG::Interface->new();
 463         $gpg->call( $CONFIG{'gpg'} );
 464         $gpg->options->hash_init( 'homedir' => $gnupghome );
 465         $gpg->options->meta_interactive( 0 );
 466         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 467         my $pid = $gpg->import_keys(handles => $handles);
 468         my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 469         waitpid $pid, 0;
 470
 471         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 472                 return undef;
 473         };
 474         return 1;
 475 };
 476
 477
 478 ######
 479 # Send an email to $address.  If $can_encrypt is true then the mail
 480 # will be PGP/MIME encrypted to $longkeyid.
 481 #
 482 # $longkeyid, $uid, and @attached will be used in the email and the template.
 483 ######
 484 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 485 sub send_mail($$$@) {
 486         my ($address, $can_encrypt, $key_id, @keys) = @_;
 487
 488         my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
 489             or die "Error creating template: $Text::Template::ERROR";
 490
 491         my @uids;
 492         for my $key (@keys) {
 493             push @uids, $key->{'text'};
 494         };
 495         my $message = $template->fill_in(HASH => { key => $key_id,
 496                                                    uids => \@uids,
 497                                                    owner => $CONFIG{'owner'}})
 498             or die "Error filling template in: $Text::Template::ERROR";
 499
 500         my $message_entity = MIME::Entity->build(
 501                 Type        => "text/plain",
 502                 Charset     => "utf-8",
 503                 Disposition => 'inline',
 504                 Data        => $message);
 505
 506         my @key_entities;
 507         for my $key (@keys) {
 508                 $message_entity->attach(
 509                         Type        => "application/pgp-keys",
 510                         Disposition => 'attachment',
 511                         Encoding    => "7bit",
 512                         Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
 513                         Data        => $key->{'key'},
 514                         Filename    => "0x$key_id.".$key->{'serial'}.".asc");
 515         };
 516
 517         if ($can_encrypt) {
 518                 my $message = $message_entity->stringify();
 519
 520                 my $gpg = GnuPG::Interface->new();
 521                 $gpg->call( $CONFIG{'gpg'} );
 522                 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
 523                         'extra_args' => '--always-trust',
 524                         'armor' => 1 );
 525                 $gpg->options->meta_interactive( 0 );
 526                 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 527                 $gpg->options->push_recipients( $key_id );
 528                 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
 529                 my $pid = $gpg->encrypt(handles => $handles);
 530                 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 531                 waitpid $pid, 0;
 532                 if ($stdout eq '') {
 533                         warn ("No data from gpg for list-key $key_id\n");
 534                         next;
 535                 };
 536                 $message = $stdout;
 537
 538                 $message_entity = MIME::Entity->build(
 539                         Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');
 540
 541                 $message_entity->attach(
 542                         Type        => "application/pgp-encrypted",
 543                         Disposition => 'attachment',
 544                         Encoding    => "7bit",
 545                         Data        => "Version: 1\n");
 546
 547                 $message_entity->attach(
 548                         Type        => "application/octet-stream",
 549                         Filename    => 'msg.asc',
 550                         Disposition => 'inline',
 551                         Encoding    => "7bit",
 552                         Data        => $message);
 553         };
 554
 555         $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
 556         $message_entity->head->add("To", $address);
 557         $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
 558         $message_entity->head->add("User-Agent", $USER_AGENT);
 559         $message_entity->send();
 560         $message_entity->stringify();
 561 };
 562
 563 ######
 564 # clean up a UID so that it can be used on the FS.
 565 ######
 566 sub sanitize_uid($) {
 567         my ($uid) = @_;
 568
 569         my $good_uid = $uid;
 570         $good_uid =~ tr#/:\\#_#;
 571         trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
 572         return $good_uid;
 573 };
 574
 575 sub delete_signatures($$$$$) {
 576         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $keyids) =@_;
 577
 578         my ($stdout, $stderr, $status) =
 579                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 580
 581         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 582                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 583                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 584                 $stdout =~ s/\n/\\n/g;
 585                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 586                 my $line = pop @sigline;
 587                 my $answer = "no";
 588                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 589                         debug("[sigremoval] doing line $line.");
 590                         my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
 591                         if ($signer eq $longkeyid) {
 592                                 debug("[sigremoval] selfsig ($signer).");
 593                                 $answer = "no";
 594                         } elsif (grep { $signer eq $_ } @{$keyids}) {
 595                                 debug("[sigremoval] signed by us ($signer).");
 596                                 $answer = "no";
 597                                 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 598                         } else {
 599                                 debug("[sigremoval] not interested in that sig ($signer).");
 600                                 $answer = "yes";
 601                         };
 602                 } else {
 603                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 604                 };
 605                 ($stdout, $stderr, $status) =
 606                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 607         };
 608 };
 609
 610
 611
 612 my $USER;
 613 my @KEYIDS;
 614 my $params;
 615
 616 Getopt::Long::config('bundling');
 617 if (!GetOptions (
 618         '-h'              =>  \$params->{'help'},
 619         '--help'          =>  \$params->{'help'},
 620         '--version'       =>  \$params->{'version'},
 621         '-V'              =>  \$params->{'version'},
 622         '-u=s'            =>  \$params->{'local-user'},
 623         '--local-user=s'  =>  \$params->{'local-user'},
 624         '-m'              =>  \$params->{'mail'},
 625         '--mail'          =>  \$params->{'mail'},
 626         '-M'              =>  \$params->{'no-mail'},
 627         '--no-mail'       =>  \$params->{'no-mail'},
 628         '-R'              =>  \$params->{'no-download'},
 629         '--no-download'   =>  \$params->{'no-download'},
 630         )) {
 631         usage(\*STDERR, 1);
 632 };
 633 if ($params->{'help'}) {
 634         usage(\*STDOUT, 0);
 635 };
 636 if ($params->{'version'}) {
 637         version(\*STDOUT);
 638         exit(0);
 639 };
 640 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
 641
 642
 643
 644 if ($params->{'local-user'}) {
 645         $USER = $params->{'local-user'};
 646         $USER =~ s/^0x//i;
 647         unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
 648                 print STDERR "-u $USER is not a keyid.\n";
 649                 usage(\*STDERR, 1);
 650         };
 651         $USER = uc($USER);
 652 };
 653
 654 for my $keyid (@ARGV) {
 655         $keyid =~ s/^0x//i;
 656         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8}|[A-Za-z0-9]{32})?$/) {
 657                 print STDERR "$keyid is not a keyid.\n";
 658                 usage(\*STDERR, 1);
 659         };
 660         push @KEYIDS, uc($keyid);
 661 };
 662
 663 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
 664 $CONFIG{'no-mail'}     = $params->{'no-mail'}     if defined $params->{'no-mail'};
 665 $CONFIG{'mail'}        = $params->{'mail'}        if defined $params->{'mail'};
 666
 667
 668 #################
 669 # import own keys
 670 #################
 671         my $gpg = GnuPG::Interface->new();
 672         $gpg->call( $CONFIG{'gpg'} );
 673         $gpg->options->hash_init(
 674                 'homedir' => $GNUPGHOME,
 675                 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 676         $gpg->options->meta_interactive( 0 );
 677         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 678         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 679         my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'});
 680         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 681         waitpid $pid, 0;
 682         if ($stdout eq '') {
 683                 warn ("No data from gpg for list-key\n");
 684                 next;
 685         };
 686         foreach my $keyid (@{$CONFIG{'keyid'}}) {
 687                 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
 688                         info("Importing $keyid");
 689                         system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME";
 690                 }
 691         }
 692
 693 #############################
 694 # receive keys from keyserver
 695 #############################
 696 my @keyids_ok;
 697 my @keyids_failed;
 698 if ($CONFIG{'no-download'}) {
 699         @keyids_ok = @KEYIDS;
 700 } else {
 701         my $gpg = GnuPG::Interface->new();
 702         $gpg->call( $CONFIG{'gpg'} );
 703         $gpg->options->hash_init(
 704                 'homedir' => $GNUPGHOME,
 705                 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 706         $gpg->options->meta_interactive( 0 );
 707         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 708
 709         my @local_keyids = @KEYIDS;
 710         for my $keyid (@local_keyids) {
 711                 info ("fetching $keyid...");
 712                 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
 713                 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 714                 waitpid $pid, 0;
 715
 716 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 717 # [GNUPG:] NODATA 1
 718 # [GNUPG:] NODATA 1
 719 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 720                 my $handled = 0;
 721                 for my $line (split /\n/, $status) {
 722                         if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
 723                                 my $imported_key = $1;
 724                                 if ($keyid ne $imported_key &&
 725                                     $keyid ne substr($imported_key, -16) &&
 726                                     $keyid ne substr($imported_key, -8)) {
 727                                     warn("Imported unexpected key.  expected: $keyid; got: $imported_key.\n");
 728                                     next;
 729                                 };
 730                                 push @keyids_ok, $keyid;
 731                                 shift @KEYIDS;
 732                                 $handled = 1;
 733                                 last;
 734                         } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
 735                                 push @keyids_failed, $keyid;
 736                                 shift @KEYIDS;
 737                                 $handled = 1;
 738                                 last;
 739                         };
 740                 };
 741                 unless ($handled) {
 742                         notice ("Huh, what's up with $keyid?");
 743                         push @keyids_failed, $keyid;
 744                         shift @KEYIDS;
 745                 };
 746         };
 747         die ("Still keys in \@KEYIDS.  This should not happen.") if scalar @KEYIDS;
 748         notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
 749 };
 750
 751 ###########
 752 # sign keys
 753 ###########
 754 unless ($CONFIG{'no-sign'}) {
 755         info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
 756         for my $keyid (@keyids_ok) {
 757                 my @command;
 758                 push @command, $CONFIG{'gpg-sign'};
 759                 push @command, '--local-user', $USER if (defined $USER);
 760                 push @command, "--homedir=$GNUPGHOME";
 761                 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 762                 push @command, '--edit', $keyid;
 763                 push @command, 'sign';
 764                 print join(' ', @command),"\n";
 765                 system (@command);
 766         };
 767 };
 768
 769 ##################
 770 # export and prune
 771 ##################
 772 KEYS:
 773 for my $keyid (@keyids_ok) {
 774         # get key listing
 775         #################
 776         my $gpg = GnuPG::Interface->new();
 777         $gpg->call( $CONFIG{'gpg'} );
 778         $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
 779         $gpg->options->meta_interactive( 0 );
 780         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 781         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 782         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 783         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 784         waitpid $pid, 0;
 785         if ($stdout eq '') {
 786                 warn ("No data from gpg for list-key $keyid\n");
 787                 next;
 788         };
 789         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 790         if (scalar @publine == 0) {
 791                 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
 792                 next;
 793         };
 794         my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 795         if (scalar @publine > 0) {
 796                 warn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint\n");
 797                 next;
 798         };
 799         unless (defined $longkeyid) {
 800                 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
 801                 next;
 802         };
 803         unless (defined $flags) {
 804                 warn ("Didn't find flags in --list-key of key $keyid.\n");
 805                 next;
 806         };
 807         my $can_encrypt = $flags =~ /E/;
 808
 809         # export the key
 810         ################
 811         my $asciikey = export_key($GNUPGHOME, $keyid);
 812         if ($asciikey eq '') {
 813                 warn ("No data from gpg for export $keyid\n");
 814                 next;
 815         };
 816
 817         my @UIDS;
 818         my $uid_number = 0;
 819         while (1) {
 820                 my $this_uid_text = '';
 821                 $uid_number++;
 822                 debug("Doing key $keyid, uid $uid_number");
 823                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 824
 825                 # import into temporary gpghome
 826                 ###############################
 827                 my $result = import_key($tempdir, $asciikey);
 828                 unless ($result) {
 829                         warn ("Could not import $keyid into temporary gnupg.\n");
 830                         next;
 831                 };
 832
 833                 # prune it
 834                 ##########
 835                 $gpg = GnuPG::Interface->new();
 836                 $gpg->call( $CONFIG{'gpg-delsig'} );
 837                 $gpg->options->hash_init(
 838                         'homedir' => $tempdir,
 839                         'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 840                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 841                 $pid = $gpg->wrap_call(
 842                         commands     => [ '--edit' ],
 843                         command_args => [ $keyid ],
 844                         handles      => $handles );
 845
 846                 debug("Starting edit session");
 847                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 848
 849                 # delete other uids
 850                 ###################
 851                 my $number_of_subkeys = 0;
 852                 my $i = 1;
 853                 my $have_one = 0;
 854                 my $is_uat = 0;
 855                 my $delete_some = 0;
 856                 debug("Parsing stdout output.");
 857                 for my $line (split /\n/, $stdout) {
 858                         debug("Checking line $line");
 859                         my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
 860                         if ($type eq 'sub') {
 861                                 $number_of_subkeys++;
 862                         };
 863                         next unless ($type eq 'uid' || $type eq 'uat');
 864                         debug("line is interesting.");
 865                         if ($uid_number != $i) {
 866                                 debug("mark for deletion.");
 867                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 868                                 $delete_some = 1;
 869                         } else {
 870                                 debug("keep it.");
 871                                 $have_one = 1;
 872                                 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
 873                                 $is_uat = $type eq 'uat';
 874                         };
 875                         $i++;
 876                 };
 877                 debug("Parsing stdout output done.");
 878                 unless ($have_one) {
 879                         debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
 880                         info("key $keyid done.");
 881                         last;
 882                 };
 883                 if ($is_uat) {
 884                         notice("Can't handle attribute userid of key $keyid.");
 885                         next;
 886                 };
 887                 if ($delete_some) {
 888                         debug("need to delete a few uids.");
 889                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
 890                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 891                 };
 892
 893                 # delete subkeys
 894                 ################
 895                 if ($number_of_subkeys > 0) {
 896                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
 897                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 898                         };
 899                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 900                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 901                 };
 902
 903                 # delete signatures
 904                 ###################
 905                 my $signed_by_me = 0;
 906                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 907                 delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $CONFIG{'keyid'});
 908
 909
 910
 911                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 912                 waitpid $pid, 0;
 913
 914                 my $asciikey = export_key($tempdir, $keyid);
 915                 if ($asciikey eq '') {
 916                         warn ("No data from gpg for export $keyid\n");
 917                         next;
 918                 };
 919
 920                 if ($signed_by_me) {
 921                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
 922                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0);
 923                                 next unless $write;
 924                         };
 925                         my $keydir = "$KEYSBASE/$DATE_STRING";
 926                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
 927
 928                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
 929                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
 930                         print KEY $asciikey;
 931                         close KEY;
 932
 933                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
 934
 935                         info("$longkeyid $uid_number $this_uid_text done.");
 936                 } else {
 937                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
 938                 };
 939         };
 940
 941         if (scalar @UIDS == 0) {
 942                 info("found no signed uids for $keyid");
 943         } else {
 944                 next if $CONFIG{'no-mail'}; # do not send mail
 945
 946                 my @attached;
 947                 for my $uid (@UIDS) {
 948                         trace("UID: $uid->{'text'}\n");
 949                         if ($uid->{'is_uat'}) {
 950                                 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
 951                                 push @attached, $uid if $attach;
 952                         } elsif ($uid->{'text'} !~ /@/) {
 953                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
 954                                 push @attached, $uid if $attach;
 955                         };
 956                 };
 957
 958                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
 959                 for my $uid (@UIDS) {
 960                         if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
 961                                 my $address = $uid->{'text'};
 962                                 $address =~ s/.*<(.*)>.*/$1/;
 963                                 if ($CONFIG{'mail'} or ask("Send mail to '$address' for $uid->{'text'}?", 1)) {
 964                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 965
 966                                         my $keydir = "$KEYSBASE/$DATE_STRING";
 967                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
 968                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
 969                                         print KEY $mail;
 970                                         close KEY;
 971                                 };
 972                         };
 973                 };
 974         };
 975
 976 };