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         my ($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, $longkeyid, $keyids) =@_;
 577
 578         my $signed_by_me = 0;
 579
 580         my ($stdout, $stderr, $status) =
 581                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 582
 583         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 584                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 585                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 586                 $stdout =~ s/\n/\\n/g;
 587                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 588                 my $line = pop @sigline;
 589                 my $answer = "no";
 590                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 591                         debug("[sigremoval] doing line $line.");
 592                         my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
 593                         if ($signer eq $longkeyid) {
 594                                 debug("[sigremoval] selfsig ($signer).");
 595                                 $answer = "no";
 596                         } elsif (grep { $signer eq $_ } @{$keyids}) {
 597                                 debug("[sigremoval] signed by us ($signer).");
 598                                 $answer = "no";
 599                                 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
 600                         } else {
 601                                 debug("[sigremoval] not interested in that sig ($signer).");
 602                                 $answer = "yes";
 603                         };
 604                 } else {
 605                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 606                 };
 607                 ($stdout, $stderr, $status) =
 608                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 609         };
 610
 611         return $signed_by_me;
 612 };
 613
 614
 615
 616 my $USER;
 617 my @KEYIDS;
 618 my $params;
 619
 620 Getopt::Long::config('bundling');
 621 if (!GetOptions (
 622         '-h'              =>  \$params->{'help'},
 623         '--help'          =>  \$params->{'help'},
 624         '--version'       =>  \$params->{'version'},
 625         '-V'              =>  \$params->{'version'},
 626         '-u=s'            =>  \$params->{'local-user'},
 627         '--local-user=s'  =>  \$params->{'local-user'},
 628         '-m'              =>  \$params->{'mail'},
 629         '--mail'          =>  \$params->{'mail'},
 630         '-M'              =>  \$params->{'no-mail'},
 631         '--no-mail'       =>  \$params->{'no-mail'},
 632         '-R'              =>  \$params->{'no-download'},
 633         '--no-download'   =>  \$params->{'no-download'},
 634         )) {
 635         usage(\*STDERR, 1);
 636 };
 637 if ($params->{'help'}) {
 638         usage(\*STDOUT, 0);
 639 };
 640 if ($params->{'version'}) {
 641         version(\*STDOUT);
 642         exit(0);
 643 };
 644 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
 645
 646
 647
 648 if ($params->{'local-user'}) {
 649         $USER = $params->{'local-user'};
 650         $USER =~ s/^0x//i;
 651         unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
 652                 print STDERR "-u $USER is not a keyid.\n";
 653                 usage(\*STDERR, 1);
 654         };
 655         $USER = uc($USER);
 656 };
 657
 658 for my $keyid (@ARGV) {
 659         $keyid =~ s/^0x//i;
 660         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8}|[A-Za-z0-9]{32})?$/) {
 661                 print STDERR "$keyid is not a keyid.\n";
 662                 usage(\*STDERR, 1);
 663         };
 664         push @KEYIDS, uc($keyid);
 665 };
 666
 667 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
 668 $CONFIG{'no-mail'}     = $params->{'no-mail'}     if defined $params->{'no-mail'};
 669 $CONFIG{'mail'}        = $params->{'mail'}        if defined $params->{'mail'};
 670
 671
 672 #################
 673 # import own keys
 674 #################
 675         my $gpg = GnuPG::Interface->new();
 676         $gpg->call( $CONFIG{'gpg'} );
 677         $gpg->options->hash_init(
 678                 'homedir' => $GNUPGHOME,
 679                 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 680         $gpg->options->meta_interactive( 0 );
 681         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 682         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 683         my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'});
 684         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 685         waitpid $pid, 0;
 686         if ($stdout eq '') {
 687                 warn ("No data from gpg for list-key\n");
 688                 next;
 689         };
 690         foreach my $keyid (@{$CONFIG{'keyid'}}) {
 691                 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
 692                         info("Importing $keyid");
 693                         system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME";
 694                 }
 695         }
 696
 697 #############################
 698 # receive keys from keyserver
 699 #############################
 700 my @keyids_ok;
 701 my @keyids_failed;
 702 if ($CONFIG{'no-download'}) {
 703         @keyids_ok = @KEYIDS;
 704 } else {
 705         my $gpg = GnuPG::Interface->new();
 706         $gpg->call( $CONFIG{'gpg'} );
 707         $gpg->options->hash_init(
 708                 'homedir' => $GNUPGHOME,
 709                 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
 710         $gpg->options->meta_interactive( 0 );
 711         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 712
 713         my @local_keyids = @KEYIDS;
 714         for my $keyid (@local_keyids) {
 715                 info ("fetching $keyid...");
 716                 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
 717                 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 718                 waitpid $pid, 0;
 719
 720 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
 721 # [GNUPG:] NODATA 1
 722 # [GNUPG:] NODATA 1
 723 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
 724                 my $handled = 0;
 725                 for my $line (split /\n/, $status) {
 726                         if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
 727                                 my $imported_key = $1;
 728                                 if ($keyid ne $imported_key &&
 729                                     $keyid ne substr($imported_key, -16) &&
 730                                     $keyid ne substr($imported_key, -8)) {
 731                                     warn("Imported unexpected key.  expected: $keyid; got: $imported_key.\n");
 732                                     next;
 733                                 };
 734                                 push @keyids_ok, $keyid;
 735                                 shift @KEYIDS;
 736                                 $handled = 1;
 737                                 last;
 738                         } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
 739                                 push @keyids_failed, $keyid;
 740                                 shift @KEYIDS;
 741                                 $handled = 1;
 742                                 last;
 743                         };
 744                 };
 745                 unless ($handled) {
 746                         notice ("Huh, what's up with $keyid?");
 747                         push @keyids_failed, $keyid;
 748                         shift @KEYIDS;
 749                 };
 750         };
 751         die ("Still keys in \@KEYIDS.  This should not happen.") if scalar @KEYIDS;
 752         notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
 753 };
 754
 755 ###########
 756 # sign keys
 757 ###########
 758 unless ($CONFIG{'no-sign'}) {
 759         info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
 760         for my $keyid (@keyids_ok) {
 761                 my @command;
 762                 push @command, $CONFIG{'gpg-sign'};
 763                 push @command, '--local-user', $USER if (defined $USER);
 764                 push @command, "--homedir=$GNUPGHOME";
 765                 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
 766                 push @command, '--edit', $keyid;
 767                 push @command, 'sign';
 768                 print join(' ', @command),"\n";
 769                 system (@command);
 770         };
 771 };
 772
 773 ##################
 774 # export and prune
 775 ##################
 776 KEYS:
 777 for my $keyid (@keyids_ok) {
 778         # get key listing
 779         #################
 780         my $gpg = GnuPG::Interface->new();
 781         $gpg->call( $CONFIG{'gpg'} );
 782         $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
 783         $gpg->options->meta_interactive( 0 );
 784         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 785         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 786         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 787         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 788         waitpid $pid, 0;
 789         if ($stdout eq '') {
 790                 warn ("No data from gpg for list-key $keyid\n");
 791                 next;
 792         };
 793         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 794         if (scalar @publine == 0) {
 795                 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
 796                 next;
 797         };
 798         my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 799         if (scalar @publine > 0) {
 800                 warn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint\n");
 801                 next;
 802         };
 803         unless (defined $longkeyid) {
 804                 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
 805                 next;
 806         };
 807         unless (defined $flags) {
 808                 warn ("Didn't find flags in --list-key of key $keyid.\n");
 809                 next;
 810         };
 811         my $can_encrypt = $flags =~ /E/;
 812
 813         # export the key
 814         ################
 815         my $asciikey = export_key($GNUPGHOME, $keyid);
 816         if ($asciikey eq '') {
 817                 warn ("No data from gpg for export $keyid\n");
 818                 next;
 819         };
 820
 821         my @UIDS;
 822         my $uid_number = 0;
 823         while (1) {
 824                 my $this_uid_text = '';
 825                 $uid_number++;
 826                 debug("Doing key $keyid, uid $uid_number");
 827                 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 828
 829                 # import into temporary gpghome
 830                 ###############################
 831                 my $result = import_key($tempdir, $asciikey);
 832                 unless ($result) {
 833                         warn ("Could not import $keyid into temporary gnupg.\n");
 834                         next;
 835                 };
 836
 837                 # prune it
 838                 ##########
 839                 $gpg = GnuPG::Interface->new();
 840                 $gpg->call( $CONFIG{'gpg-delsig'} );
 841                 $gpg->options->hash_init(
 842                         'homedir' => $tempdir,
 843                         'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 844                 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 845                 $pid = $gpg->wrap_call(
 846                         commands     => [ '--edit' ],
 847                         command_args => [ $keyid ],
 848                         handles      => $handles );
 849
 850                 debug("Starting edit session");
 851                 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 852
 853                 # delete other uids
 854                 ###################
 855                 my $number_of_subkeys = 0;
 856                 my $i = 1;
 857                 my $have_one = 0;
 858                 my $is_uat = 0;
 859                 my $delete_some = 0;
 860                 debug("Parsing stdout output.");
 861                 for my $line (split /\n/, $stdout) {
 862                         debug("Checking line $line");
 863                         my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
 864                         if ($type eq 'sub') {
 865                                 $number_of_subkeys++;
 866                         };
 867                         next unless ($type eq 'uid' || $type eq 'uat');
 868                         debug("line is interesting.");
 869                         if ($uid_number != $i) {
 870                                 debug("mark for deletion.");
 871                                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 872                                 $delete_some++;
 873                         } else {
 874                                 debug("keep it.");
 875                                 $have_one = 1;
 876                                 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
 877                                 $is_uat = $type eq 'uat';
 878                         };
 879                         $i++;
 880                 };
 881                 debug("Parsing stdout output done.");
 882                 unless ($have_one) {
 883                         debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
 884                         info("key $keyid done.");
 885                         last;
 886                 };
 887
 888                 my $prune_some_sigs_on_uid;
 889                 my $prune_all_sigs_on_uid;
 890                 if ($is_uat) {
 891                         debug("handling attribute userid of key $keyid.");
 892                         if ($uid_number == 1) {
 893                                 debug(" attribute userid is #1, unmarking #2 for deletion.");
 894                                 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 895                                 $delete_some--;
 896                                 $prune_some_sigs_on_uid = 1;
 897                                 $prune_all_sigs_on_uid = 2;
 898                         } else {
 899                                 debug("attribute userid is not #1, unmarking #1 for deletion.");
 900                                 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 901                                 $delete_some--;
 902                                 $prune_some_sigs_on_uid = 2;
 903                                 $prune_all_sigs_on_uid = 1;
 904                         };
 905                 } else {
 906                         $prune_some_sigs_on_uid = 1;
 907                 };
 908
 909                 if ($delete_some) {
 910                         debug("need to delete $delete_some uids.");
 911                         readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
 912                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 913                 };
 914
 915                 # delete subkeys
 916                 ################
 917                 if ($number_of_subkeys > 0) {
 918                         for (my $i=1; $i<=$number_of_subkeys; $i++) {
 919                                 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 920                         };
 921                         readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 922                         readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 923                 };
 924
 925                 # delete signatures
 926                 ###################
 927                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
 928                 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
 929                 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
 930                 if (defined $prune_all_sigs_on_uid) {
 931                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
 932                         delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
 933                         readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
 934                 };
 935
 936
 937                 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 938                 waitpid $pid, 0;
 939
 940                 my $asciikey = export_key($tempdir, $keyid);
 941                 if ($asciikey eq '') {
 942                         warn ("No data from gpg for export $keyid\n");
 943                         next;
 944                 };
 945
 946                 if ($signed_by_me) {
 947                         if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
 948                                 my $write = ask("Signature on $this_uid_text is old.  Export?", 0);
 949                                 next unless $write;
 950                         };
 951                         my $keydir = "$KEYSBASE/$DATE_STRING";
 952                         -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
 953
 954                         my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
 955                         open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
 956                         print KEY $asciikey;
 957                         close KEY;
 958
 959                         push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
 960
 961                         info("$longkeyid $uid_number $this_uid_text done.");
 962                 } else {
 963                         info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
 964                 };
 965         };
 966
 967         if (scalar @UIDS == 0) {
 968                 info("found no signed uids for $keyid");
 969         } else {
 970                 next if $CONFIG{'no-mail'}; # do not send mail
 971
 972                 my @attached;
 973                 for my $uid (@UIDS) {
 974                         trace("UID: $uid->{'text'}\n");
 975                         if ($uid->{'is_uat'}) {
 976                                 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
 977                                 push @attached, $uid if $attach;
 978                         } elsif ($uid->{'text'} !~ /@/) {
 979                                 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
 980                                 push @attached, $uid if $attach;
 981                         };
 982                 };
 983
 984                 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
 985                 for my $uid (@UIDS) {
 986                         if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
 987                                 my $address = $uid->{'text'};
 988                                 $address =~ s/.*<(.*)>.*/$1/;
 989                                 if ($CONFIG{'mail'} or ask("Send mail to '$address' for $uid->{'text'}?", 1)) {
 990                                         my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
 991
 992                                         my $keydir = "$KEYSBASE/$DATE_STRING";
 993                                         my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
 994                                         open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
 995                                         print KEY $mail;
 996                                         close KEY;
 997                                 };
 998                         };
 999                 };
1000         };
1001
1002 };