caff/pgp-clean

   1 #!/usr/bin/perl -w
   2
   3 # caff  --  CA - Fire and Forget
   4 # $Id: caff 37 2005-02-28 23:20:15Z weasel $
   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> [-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<-u> I<yourkeyid>
  59
  60 Select the key that is used for signing, in case you have more than one key.
  61
  62 =back
  63
  64 =head1 FILES
  65
  66 =over
  67
  68 =item $HOME/.caffrc  -  configuration file
  69
  70 =back
  71
  72 =head1 CONFIGURATION FILE OPTIONS
  73
  74 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
  75
  76 Example:
  77
  78         $CONFIG{'owner'}       = 'Peter Palfrader';
  79         $CONFIG{'email'}       = 'peter@palfrader.org';
  80
  81 =head2 Valid keys
  82
  83 =over
  84
  85 =item B<caffhome> [string]
  86
  87 Base directory for the files caff stores.  Default: B<$HOME/.caff/>.
  88
  89 =item B<owner> [string]
  90
  91 Your name.  B<REQUIRED>.
  92
  93 =item B<email> [string]
  94
  95 Your email address, used in From: lines.  B<REQUIRED>.
  96
  97 =item B<keyid> [list of keyids]
  98
  99 A list of your keys.  This is used to determine which signatures to keep
 100 in the pruning step.  If you select a key using B<-u> it has to be in
 101 this list.  B<REQUIRED>.
 102
 103 =item B<export-sig-age> [seconds]
 104
 105 Don't export UIDs by default, on which your latest signature is older
 106 than this age.  Default: B<24*60*60> (i.e. one day).
 107
 108 =item B<keyserver> [string]
 109
 110 Keyserver to download keys from.  Default: B<subkeys.pgp.net>.
 111
 112 =item B<gpg> [string]
 113
 114 Path to the GnuPG binary.  Default: B<gpg>.
 115
 116 =item B<gpg-sign> [string]
 117
 118 Path to the GnuPG binary which is used to sign keys.  Default: what
 119 B<gpg> is set to.
 120
 121 =item B<gpg-delsig> [string]
 122
 123 Path to the GnuPG binary which is used to split off signatures.  This is
 124 needed while the upstream GnuPG is not fixed  (there are 2 bugs in the
 125 Debian Bug Tracking System).  Default: what B<gpg> is set to.
 126
 127 =item B<secret-keyring> [string]
 128
 129 Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.
 130
 131 =item B<also-encrypt-to> [keyid]
 132
 133 An additional keyid to encrypt messages to. Default: none.
 134
 135 =item B<no-download> [boolean]
 136
 137 If true, then skip the step of fetching keys from the keyserver.
 138 Default: B<0>.
 139
 140 =item B<no-sign> [boolean]
 141
 142 If true, then skip the signing step. Default: B<0>.
 143
 144 =back
 145
 146 =head1 AUTHOR
 147
 148 Peter Palfrader <peter@palfrader.org>
 149
 150 =cut
 151
 152 use strict;
 153 use IO::Handle;
 154 use English;
 155 use File::Path;
 156 use File::Temp qw{tempdir};
 157 use Fcntl;
 158 use IO::Select;
 159 use GnuPG::Interface;
 160
 161 my $REVISION = '$Rev: 37 $';
 162 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
 163 my $VERSION = "0.0.0.$REVISION_NUMER";
 164
 165 sub notice($) {
 166         my ($line) = @_;
 167         print STDERR "[NOTICE] $line\n";
 168 };
 169 sub info($) {
 170         my ($line) = @_;
 171         print STDERR "[INFO] $line\n";
 172 };
 173 sub debug($) {
 174         my ($line) = @_;
 175         print STDERR "[DEBUG] $line\n";
 176 };
 177 sub trace($) {
 178         my ($line) = @_;
 179         #print STDERR "[trace] $line\n";
 180 };
 181 sub trace2($) {
 182         my ($line) = @_;
 183         #print STDERR "[trace2] $line\n";
 184 };
 185
 186 sub make_gpg_fds() {
 187         my %fds = (
 188                 stdin => IO::Handle->new(),
 189                 stdout => IO::Handle->new(),
 190                 stderr => IO::Handle->new(),
 191                 status => IO::Handle->new() );
 192         my $handles = GnuPG::Handles->new( %fds );
 193         return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
 194 };
 195
 196 sub readwrite_gpg($$$$$%) {
 197         my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
 198
 199         trace("Entering readwrite_gpg.");
 200
 201         my ($first_line, $dummy) = split /\n/, $in;
 202         debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
 203
 204         local $INPUT_RECORD_SEPARATOR = undef;
 205         my $sout = IO::Select->new();
 206         my $sin = IO::Select->new();
 207         my $offset = 0;
 208
 209         trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
 210
 211         $inputfd->blocking(0);
 212         $stdoutfd->blocking(0);
 213         $statusfd->blocking(0) if defined $statusfd;
 214         $stderrfd->blocking(0);
 215         $sout->add($stdoutfd);
 216         $sout->add($stderrfd);
 217         $sout->add($statusfd) if defined $statusfd;
 218         $sin->add($inputfd);
 219
 220         my ($stdout, $stderr, $status) = ("", "", "");
 221         my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
 222         trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
 223
 224         my $readwrote_stuff_this_time = 0;
 225         my $do_not_wait_on_select = 0;
 226         my ($readyr, $readyw, $written);
 227         while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
 228                 if (defined $exitwhenstatusmatches) {
 229                         if ($status =~ /$exitwhenstatusmatches/m) {
 230                                 trace("readwrite_gpg found match on $exitwhenstatusmatches");
 231                                 if ($readwrote_stuff_this_time) {
 232                                         trace("read/write some more\n");
 233                                         $do_not_wait_on_select = 1;
 234                                 } else {
 235                                         trace("that's it in our while loop.\n");
 236                                         last;
 237                                 }
 238                         };
 239                 };
 240
 241                 $readwrote_stuff_this_time = 0;
 242                 trace("select waiting for ".($sout->count())." fds.");
 243                 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
 244                 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
 245                 for my $wfd (@$readyw) {
 246                         $readwrote_stuff_this_time = 1;
 247                         if (length($in) != $offset) {
 248                                 trace("writing to $wfd.");
 249                                 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
 250                                 $offset += $written;
 251                         };
 252                         if ($offset == length($in)) {
 253                                 trace("writing to $wfd done.");
 254                                 unless ($options{'nocloseinput'}) {
 255                                         close $wfd;
 256                                         trace("$wfd closed.");
 257                                 };
 258                                 $sin->remove($wfd);
 259                                 $sin = undef;
 260                         }
 261                 }
 262
 263                 next unless (defined(@$readyr)); # Wait some more.
 264
 265                 for my $rfd (@$readyr) {
 266                         $readwrote_stuff_this_time = 1;
 267                         if ($rfd->eof) {
 268                                 trace("reading from $rfd done.");
 269                                 $sout->remove($rfd);
 270                                 close($rfd);
 271                                 next;
 272                         }
 273                         trace("reading from $rfd.");
 274                         if ($rfd == $stdoutfd) {
 275                                 $stdout .= <$rfd>;
 276                                 trace2("stdout is now $stdout\n================");
 277                                 next;
 278                         }
 279                         if (defined $statusfd && $rfd == $statusfd) {
 280                                 $status .= <$rfd>;
 281                                 trace2("status is now $status\n================");
 282                                 next;
 283                         }
 284                         if ($rfd == $stderrfd) {
 285                                 $stderr .= <$rfd>;
 286                                 trace2("stderr is now $stderr\n================");
 287                                 next;
 288                         }
 289                 }
 290         }
 291         trace("readwrite_gpg done.");
 292         return ($stdout, $stderr, $status);
 293 };
 294
 295 sub export_key($$) {
 296         my ($gnupghome, $keyid) = @_;
 297
 298         my $gpg = GnuPG::Interface->new();
 299         my %confighash = ( armor => 1 );
 300         $confighash{'homedir'}=$gnupghome if (defined $gnupghome);
 301         $gpg->options->hash_init( %confighash );
 302         $gpg->options->meta_interactive( 0 );
 303         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 304         my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
 305         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 306         waitpid $pid, 0;
 307
 308         return $stdout;
 309 };
 310
 311 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
 312 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
 313 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
 314 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
 315 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 316
 317
 318 sub usage() {
 319         print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
 320         print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
 321         exit 1;
 322 };
 323
 324 usage() unless scalar @ARGV >= 1;
 325 my @KEYIDS;
 326 for my $keyid (@ARGV) {
 327         unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
 328                 print STDERR "$keyid is not a keyid.\n";
 329                 usage();
 330         };
 331         push @KEYIDS, uc($keyid);
 332 };
 333
 334
 335
 336 ##################
 337 # export and prune
 338 ##################
 339 KEYS:
 340 for my $keyid (@KEYIDS) {
 341         # get key listing
 342         #################
 343         my $gpg = GnuPG::Interface->new();
 344         $gpg->options->meta_interactive( 0 );
 345         my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 346         $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
 347         my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
 348         my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
 349         waitpid $pid, 0;
 350         if ($stdout eq '') {
 351                 warn ("No data from gpg for list-key $keyid\n");
 352                 next;
 353         };
 354         my $keyinfo = $stdout;
 355         my @publine = grep { /^pub/ } (split /\n/, $stdout);
 356         my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
 357         my $can_encrypt = $flags =~ /E/;
 358         unless (defined $longkeyid) {
 359                 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
 360                 next;
 361         };
 362
 363         # export the key
 364         ################
 365         my $asciikey = export_key(undef, $keyid);
 366         if ($asciikey eq '') {
 367                 warn ("No data from gpg for export $keyid\n");
 368                 next;
 369         };
 370
 371         my @UIDS;
 372         my $uid_number = 0;
 373         my $this_uid_text = '';
 374         $uid_number++;
 375         debug("Doing key $keyid, uid $uid_number");
 376
 377         # import into temporary gpghome
 378         ###############################
 379         my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
 380         $gpg = GnuPG::Interface->new();
 381         $gpg->options->hash_init( 'homedir' => $tempdir );
 382         $gpg->options->meta_interactive( 0 );
 383         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 384         $pid = $gpg->import_keys(handles => $handles);
 385         ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
 386         waitpid $pid, 0;
 387
 388         if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
 389                 warn ("Could not import $keyid into temporary gnupg.\n");
 390                 next;
 391         };
 392
 393         # prune it
 394         ##########
 395         $gpg = GnuPG::Interface->new();
 396         $gpg->options->hash_init(
 397                 'homedir' => $tempdir,
 398                 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
 399         ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
 400         $pid = $gpg->wrap_call(
 401                 commands     => [ '--edit' ],
 402                 command_args => [ $keyid ],
 403                 handles      => $handles );
 404
 405         debug("Starting edit session");
 406         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 407
 408         # mark all uids
 409         ###################
 410         my $number_of_subkeys = 0;
 411         my $i = 1;
 412         my $have_one = 0;
 413         my $is_uat = 0;
 414         my $delete_some = 0;
 415         debug("Parsing stdout output.");
 416         for my $line (split /\n/, $stdout) {
 417                 debug("Checking line $line");
 418                 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
 419                 if ($type eq 'sub') {
 420                         $number_of_subkeys++;
 421                 };
 422                 next unless ($type eq 'uid' || $type eq 'uat');
 423                 debug("line is interesting.");
 424                 debug("mark uid.");
 425                 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 426                 $i++;
 427         };
 428         debug("Parsing stdout output done.");
 429
 430         # delete subkeys
 431         ################
 432         if ($number_of_subkeys > 0) {
 433                 for (my $i=1; $i<=$number_of_subkeys; $i++) {
 434                         readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 435                 };
 436                 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
 437                 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
 438         };
 439
 440         # delete signatures
 441         ###################
 442         my $signed_by_me = 0;
 443         ($stdout, $stderr, $status) =
 444                 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
 445
 446         while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
 447                 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
 448                 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
 449                 $stdout =~ s/\n/\\n/g;
 450                 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
 451                 my $line = pop @sigline;
 452                 my $answer = "no";
 453                 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 454                         debug("[sigremoval] doing line $line.");
 455                         my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
 456                         if ($signer eq $longkeyid) {
 457                                 debug("[sigremoval] selfsig ($signer).");
 458                                 $answer = "no";
 459                         } else {
 460                                 debug("[sigremoval] not interested in that sig ($signer).");
 461                                 $answer = "yes";
 462                         };
 463                 } else {
 464                         debug("[sigremoval] no sig line here, only got: ".$stdout);
 465                 };
 466                 ($stdout, $stderr, $status) =
 467                         readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
 468         };
 469         readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
 470         waitpid $pid, 0;
 471
 472         $asciikey = export_key($tempdir, $longkeyid);
 473         if ($asciikey eq '') {
 474                 warn ("No data from gpg for export $longkeyid\n");
 475                 next;
 476         };
 477
 478
 479         print $asciikey;
 480 }