signing-party 1.1.10-3 / usr / bin / caff

#!/usr/bin/perl -w

# caff  --  CA - Fire and Forget
# $Id: caff 710 2014-09-13 18:01:41Z guilhem-guest $
#
# Copyright (c) 2004, 2005, 2006 Peter Palfrader <peter@palfrader.org>
# Copyright (c) 2005, 2006 Christoph Berg <cb@df7cb.de>
# Copyright (c) 2014 Guilhem Moulin <guilhem@guilhem.org>
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=pod

=head1 NAME

caff -- CA - Fire and Forget

=head1 SYNOPSIS

=over

=item B<caff> [-eERS] [-m I<yes|ask-yes|ask-no|no>] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]

=item B<caff> [-eERS] [-m I<yes|ask-yes|ask-no|no>] [-u I<yourkeyid>] [I<keyid> ..] <I</path/to/ksp-annotated.txt>

=back

=head1 DESCRIPTION

CA Fire and Forget is a script that helps you in keysigning.  It takes a list
of keyids on the command line, fetches them from a keyserver and calls GnuPG so
that you can sign it.  It then mails each key to all its email addresses - only
including the one UID that we send to in each mail, pruned from all but self
sigs and sigs done by you.  The mailed key is encrypted with itself as a means
to verify that key belongs to the recipient.

The list of keys to sign can also be provided through caff's standard
input, as gpgparticipants(1) formatted content.  Only keys for which
both the "Fingerprint OK" and "ID OK" boxes are ticked (i.e., marked
with an "x") are considered for signing.  Furthermore, the input header
must include at least one checksum line, and all checksum boxes must be
marked as verified (with an "x").

=head1 OPTIONS

=over

=item B<-e>, B<--export-old>

Export old signatures. Default is to ask the user for each old signature.

=item B<-E>, B<--no-export-old>

Do not export old signatures. Default is to ask the user for each old
signature.

=item B<-m>, B<--mail> I<yes|ask-yes|ask-no|no>

Whether to send mail after signing. Default is to ask, for each uid,
with a default value of yes.

=item B<-R>, B<--no-download>

Do not retrieve the key to be signed from a keyserver.

=item B<-S>, B<--no-sign>

Do not sign the keys.

=item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>

Select the key that is used for signing, in case you have more than one key.
To sign with multiple keys at once, separate multiple keyids by comma. This
option requires the key(s) to be defined through the keyid variable in the
configuration file.

=item B<--key-file> I<file>

Import keys from file. Can be supplied more than once.

=item B<--keys-from-gnupg>

Try to import keys from your standard GnuPG keyrings.

=back

=head1 FILES

=over

=item $HOME/.caffrc  -  configuration file

=item $HOME/.caff/keys/yyyy-mm-dd/  -  processed keys

=item $HOME/.caff/gnupghome/  -  caff's working dir for gpg

=item $HOME/.caff/gnupghome/gpg.conf  -  gpg configuration

useful options include use-agent, keyserver-options, default-cert-level, etc.

=back

=head1 CONFIGURATION FILE OPTIONS

The configuration file is a perl script that sets values in the hash B<%CONFIG>.
The file is generated when it does not exist.

Example:

	$CONFIG{'owner'} = q{Peter Palfrader};
	$CONFIG{'email'} = q{peter@palfrader.org};
	$CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];

=head2 Required basic settings

=over

=item B<owner> [string]

Your name.  B<REQUIRED>.

=item B<email> [string]

Your email address, used in From: lines.  B<REQUIRED>.

=item B<keyid> [list of keyids]

A list of your keys.  This is used to determine which signatures to keep
in the pruning step.  If you select a key using B<-u> it has to be in
this list.  B<REQUIRED>.

=back

=head2 General settings

=over

=item B<caffhome> [string]

Base directory for the files caff stores.  Default: B<$HOME/.caff/>.

=back

=head2 GnuPG settings

=over

=item B<gpg> [string]

Path to the GnuPG binary.  Default: B<gpg>.

=item B<gpg-sign> [string]

Path to the GnuPG binary which is used to sign keys.  Default: what
B<gpg> is set to.

=item B<gpg-delsig> [string]

Path to the GnuPG binary which is used to split off signatures.  This was
needed while the upstream GnuPG was not fixed.  Default: what B<gpg>
is set to.

=item B<secret-keyring> [string]

Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.

=item B<also-encrypt-to> [keyid, or list of keyids]

Additional keyids to encrypt messages to. Default: none.

=item B<gpg-sign-type> [string]

The prefix to the "sign" command used to make the signature from gpg's
shell.  Can be set to a mix of "l" (local), "nr" (non-revocable) or "t"
(trust) to make a signature of the given type.  See gpg(1) for
details.  Default: "" (i.e., make a regular, exportable, signature).

=item B<gpg-sign-args> [string]

Additional commands to pass to gpg after the "sign" command.
Default: none.

=back

=head2 Keyserver settings

=over

=item B<keyserver> [string]

Keyserver to download keys from.  Default: the keyserver defined in
~/.gnupg/gpg.conf if found, otherwise B<pool.sks-keyservers.net>.

=item B<no-download> [boolean]

If true, then skip the step of fetching keys from the keyserver.
Default: B<0>.

=item B<key-files> [list of files]

A list of files containing keys to be imported.

=back

=head2 Signing settings

=over

=item B<no-sign> [boolean]

If true, then skip the signing step. Default: B<0>.

=item B<ask-sign> [boolean]

If true, then pause before continuing to the signing step.
This is useful for offline signing. Default: B<0>.

=item B<export-sig-age> [seconds]

Don't export UIDs by default, on which your latest signature is older
than this age.  Default: B<24*60*60> (i.e. one day).

=item B<local-user> [keyid, or list of keyids]

Select the key that is used for signing, in case you have more than one key.
With multiple keyids, sign with each key in turn.

=item B<also-lsign-in-gnupghome> [auto|ask|no]

Whether to locally sign the UIDs in the user's GnuPGHOME, in addition to
caff's signatures in its own GnuPGHOME.  Such signatures are not
exportable.  This can be useful when the recipient forgets to upload the
signatures caff sent (or if they non-exportable as well), as it gives a
way to keep track of which UIDs were verified.  However, note that local
signatures will not be deleted once the recipient does the upload and
the signer refreshes her keyring.

If the value is not I<no> and if B<gpg-sign-type> contains "l", each
(local) signature is merely exported from caff's own GnuPGHOME to the
user's.  Otherwise, if the value is I<auto>, each UID signed in caff's
own GnuPGHOME gets automatically locally signed in the user's, using the
same certification level; this requires a working gpg-agent(1).  If
I<ask>, the user is prompted for which UIDs to locally sign.  Default:
B<no>.

=item B<show-photos> [boolean]

If true, then before signing a key gpg will display the photos attached
to it, if any.  (The photo viewer can be specified with a "photo-viewer"
option in caff's GnuPGHOME.)  Default: B<0>.

=back

=head2 Mail settings

=over

=item B<mail> [yes|ask-yes|ask-no|no]

Whether to send mails. This is a quad-option, with which you can set the
behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
each uid, with according defaults for the question. Default: B<ask-yes>.

In any case, the messages are also written to $CONFIG{'caffhome'}/keys/

=item B<mail-cant-encrypt> [yes|ask-yes|ask-no|no]

The value of this option is considered instead of that of B<mail> for
recipient keys without encryption capability.  Default to the value of
B<mail>.

=item B<mail-template> [string]

Email template which is used as the body text for the email sent out
instead of the default text if specified. The following perl variables
can be used in the template:

=over

=item B<{owner}> [string]

Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.

=item B<{key}> [string]

The keyid of the key you signed.

=item B<{@uids}> [array]

The UIDs for which signatures are included in the mail.

=back

Note that you should probably customize the template if you intend to
send non-exportable signatures (i.e., if B<gpg-sign-type> contains "l"),
as uploading such signatures doesn't make sense, and they require the
import option "import-local-sigs" which isn't set by default.

=item B<reply-to> [string]

Add a Reply-To: header to messages sent. Default: none.

=item B<bcc> [string]

Address to send blind carbon copies to when sending mail.
Default: none.

=item B<mailer-send> [array]

Parameters to pass to Mail::Mailer.
This could for example be

	$CONFIG{'mailer-send'} =  [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];

to use the perl SMTP client or

	$CONFIG{'mailer-send'} =  [ 'sendmail', '-f', $CONFIG{'email'}, '-it' ];

to pass arguments to the sendmail program.
For more information run C<< perldoc Mail::Mailer >>.
Setting this option is strongly discouraged.  Fix your local MTA
instead.
Default: none.

=back

=head1 AUTHORS

=over

=item Peter Palfrader <peter@palfrader.org>

=item Christoph Berg <cb@df7cb.de>

=item Guilhem Moulin <guilhem@guilhem.org>

=back

=head1 WEBSITE

http://pgp-tools.alioth.debian.org/

=head1 SEE ALSO

gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/

=cut

use strict;
use IO::Handle;
use English '-no_match_vars';
use File::Copy qw{copy};
use File::Path qw{make_path};
use File::Temp;
use Text::Template;
use MIME::Entity;
use Encode ();
use I18N::Langinfo qw{langinfo};
use Net::IDN::Encode ();
use Fcntl;
use IO::Select;
use Getopt::Long;
use GnuPG::Interface;
use POSIX qw{strftime setlocale};

my %CONFIG;
my $REVISION = '$Rev: 710 $';
my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
$REVISION_NUMER //= 'unknown';
my $VERSION = "0.0.0.$REVISION_NUMER";
my $LOCALE = Encode::find_encoding(langinfo(I18N::Langinfo::CODESET()));

# Global variables
my @KEYIDS;
my $params;

##
# Display an error message on STDERR and then exit.
#
# @param $exitcode exit code status to use to end the program
# @param $line     error message to display on STDERR
#
sub myerror($$) {
	my ($exitcode, $line) = @_;
	print "[ERROR] $line\n";	
	exit $exitcode;
};

sub mywarn($) {
	my ($line) = @_;
	print "[WARN] $line\n";
};
sub notice($) {
	my ($line) = @_;
	print "[NOTICE] $line\n";
};
sub info($) {
	my ($line) = @_;
	print "[INFO] $line\n";
};
sub debug($) {
	my ($line) = @_;
	#print "[DEBUG] $line\n";
};
sub trace($) {
	my ($line) = @_;
	#print "[trace] $line\n";
};
sub trace2($) {
	my ($line) = @_;
	#print "[trace2] $line\n";
};


open my $NULL, '+<', '/dev/null';
sub generate_config() {
	notice("Error: \$LOGNAME is not set.") unless defined $ENV{'LOGNAME'};
	my $gecos = defined $ENV{'LOGNAME'} ? (getpwnam($ENV{LOGNAME}))[6] : undef;
	my $email;
	my @keys;
	# BSD does not have hostname -f, so we try without -f first
	my $hostname = `hostname`;
	$hostname = `hostname -f` unless $hostname =~ /\./;
	chomp $hostname;
	my ($Cgecos,$Cemail,$Ckeys) = ('','','');

	if (defined $gecos) {
		$gecos =~ s/,.*//;

		my $gpg = GnuPG::Interface->new();
		$gpg->call( 'gpg' );
		$gpg->options->hash_init(
			'meta_interactive' => 0,
			'always_trust' => 1,
			'extra_args' => [ qw{ --no-auto-check-trustdb --with-colons --fixed-list-mode } ] );
		my $handles = make_gpg_fds( map {$_ => undef} qw/stdin stdout stderr status/ );
		my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $gecos ]);
		my ($stdout, $stderr, $status) = readwrite_gpg('', $handles);
		waitpid $pid, 0;

		if ($stdout eq '') {
			warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
		};

		@keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2}([0-9A-F]{16}):/mg);
		unless (scalar @keys) {
			info("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
			@keys = qw{0123456789abcdef 89abcdef76543210};
			$Ckeys = '#';
		}
		($email) = ($stdout =~ /^uid:(?:[^:]*:){8}[^:]+ <([^:]+\@[^:]+)>(?::.*)?$/m);
		unless (defined $email) {
			info("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
			$email = $ENV{'LOGNAME'}.'@'.$hostname;
			$Cemail = '#';
		}
	} else {
		$gecos = 'Unknown Caff User';
		$email = $ENV{'LOGNAME'}.'@'.$hostname;
		@keys = qw{0123456789abcdef 89abcdef76543210};
		($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
	};

	my $template = <<EOT;
# .caffrc -- vim:ft=perl:
# This file is in perl(1) format - see caff(1) for details.

$Cgecos\$CONFIG{'owner'} = '$gecos';
$Cemail\$CONFIG{'email'} = '$email';
#\$CONFIG{'reply-to'} = 'foo\@bla.org';

# You can get your long keyid from
#   gpg --keyid-format long --list-key <yourkeyid|name|emailaddress..>
#
# If you have a v4 key, it will simply be the last 16 digits of
# your fingerprint.
#
# Example:
#   \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
#  or, if you have more than one key:
#   \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
$Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];

# Select this/these keys to sign with
#\$CONFIG{'local-user'} = [ qw{@keys} ];

# Additionally encrypt messages for these keyids
#\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];

# Mail template to use for the encrypted part
#\$CONFIG{'mail-template'} = << 'EOM';
EOT

	$template .= "#$_" foreach <DATA>;
	$template .= "#EOM\n";
	return $template;
};

sub check_executable($$) {
	# (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
	# so we want to check manually.)
	my ($purpose, $fn) = @_;
	# Only check provided fnames with a slash in them.
	return unless defined $fn;
	if ($fn =~ m!/!) {
		die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x $fn;
	} else {
		for my $p (split(':', $ENV{PATH})) {
			return if -x "$p/$fn";
		};
		die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x $fn;
	};
};

sub load_config() {
	my $config = $ENV{'HOME'} . '/.caffrc';
	unless (-f $config) {
		print "No configfile $config present, I will use this template:\n";
		my $template = generate_config();
		print "$template\nPlease edit $config and run caff again.\n";
		open F, '>', $config or die "$config: $!";
		print F $template;
		close F;
		exit(1);
	}
	unless (scalar eval `cat $config`) {
		die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
	};

	$CONFIG{'caffhome'} //= $ENV{'HOME'}.'/.caff';
	die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
	die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
	die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
	die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
	for my $keyid (@{$CONFIG{'keyid'}}) {
		$keyid =~ /^((?:0x)?\p{AHex}{16}|\p{AHex}{40}|(?:\p{AHex}{4} ){5}(?: \p{AHex}{4}){5})$/
		  or die ("$PROGRAM_NAME: key $keyid is not specified as a long (16 digit) keyid or fingerprint in $config.\n");
	};
	@{$CONFIG{'keyid'}} = map { s/^0x//; uc (substr y/ //dr, -16) } @{$CONFIG{'keyid'}};
	$CONFIG{'export-sig-age'} //= 24*60*60;
	$CONFIG{'gpg'} //= 'gpg';
	$CONFIG{'gpg-sign'} //= $CONFIG{'gpg'};
	$CONFIG{'gpg-delsig'} //= $CONFIG{'gpg'};
	check_executable($_, $CONFIG{$_}) for qw/gpg gpg-sign gpg-delsig/;
	$CONFIG{'secret-keyring'} //= ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg';
	$CONFIG{'no-download'} //= 0;
	$CONFIG{'no-sign'} //= 0;
	$CONFIG{'key-files'} //= [];
	$CONFIG{'mailer-send'} //= [];
	die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
	unless (defined $CONFIG{'mail-template'}) {
		$CONFIG{'mail-template'} .= $_ foreach <DATA>;
	}
	$CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ]
		if defined $CONFIG{'also-encrypt-to'} and !ref $CONFIG{'also-encrypt-to'};
	if (defined $LOCALE) {
		$CONFIG{$_} = $LOCALE->decode($CONFIG{$_}) for qw/owner mail-template/;
		$CONFIG{$_} = email_to_ascii($LOCALE->decode($CONFIG{$_}))
			for grep {defined $CONFIG{$_}} qw/email bcc reply-to/;
	}
	$CONFIG{'gpg-sign-type'} //= '';
	die "$PROGRAM_NAME: $CONFIG{'gpg-sign-type'} is an invalid signature type.\n"
		unless $CONFIG{'gpg-sign-type'} =~ /^(?:l|nr|t)*$/;
	$CONFIG{'also-lsign-in-gnupghome'} //= 'no';
	$CONFIG{'also-lsign-in-gnupghome'} = 'no' if $CONFIG{'no-sign'};
	die "$PROGRAM_NAME: invalid value for 'also-lsign-in-gnupghome': $CONFIG{'also-lsign-in-gnupghome'}.\n"
		unless grep { $_ eq $CONFIG{'also-lsign-in-gnupghome'} } qw/auto ask no/;
	# ensure there is a working gpg-agent if $CONFIG{'also-lsign-in-gnupghome'} is 'auto'
	$CONFIG{'also-lsign-in-gnupghome'} = 'ask'
		if $CONFIG{'also-lsign-in-gnupghome'} eq 'auto' and $CONFIG{'gpg-sign-type'} !~ /l/ and system qw/gpg-agent -q/;
	$CONFIG{'show-photos'} //= 0;
};

# Create a GnuPG::Handles object.  This function takes a hash where keys
# are handle names, and values are either IO::Handle objects, in which
# case the existing handle is used, or undefined, in which case a new
# IO::Handle is created.
sub make_gpg_fds(%) {
	my %fds = @_;

	my @notnewfds = grep {defined $fds{$_}} keys %fds;
	$fds{$_} = IO::Handle::->new() foreach grep {!defined $fds{$_}} keys %fds;

	my $handles = GnuPG::Handles::->new( %fds );
	$handles->options($_)->{direct} = 1 foreach @notnewfds;
	return $handles;
};


sub readwrite_gpg($$%) {
	my ($in, $handles, %options) = @_;

	my ($inputfd, $stdoutfd, $stderrfd, $statusfd) = @$handles{qw/stdin stdout stderr status/};
	trace("Entering readwrite_gpg.");

	my ($first_line, undef) = split /\n/, $in;
	debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));

	local $INPUT_RECORD_SEPARATOR = undef;
	my $sout = IO::Select->new();
	my $sin = IO::Select->new();
	my $offset = 0;

	trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".($statusfd // 'undef').".");

	$inputfd->blocking(0);
	$stdoutfd->blocking(0);
	$statusfd->blocking(0) if defined $statusfd;
	$stderrfd->blocking(0);
	$sout->add($stdoutfd);
	$sout->add($stderrfd);
	$sout->add($statusfd) if defined $statusfd;
	$sin->add($inputfd);

	my ($stdout, $stderr, $status) = ("", "", "");
	my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
	trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;

	my $readwrote_stuff_this_time = 0;
	my $do_not_wait_on_select = 0;
	my ($readyr, $readyw, $written);
	while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
		if (defined $exitwhenstatusmatches and $status =~ /^\[GNUPG:\] $exitwhenstatusmatches$/m) {
			trace("readwrite_gpg found match on $exitwhenstatusmatches");
			if ($readwrote_stuff_this_time) {
				trace("read/write some more\n");
				$do_not_wait_on_select = 1;
			} else {
				trace("that's it in our while loop.\n");
				last;
			}
		};

		$readwrote_stuff_this_time = 0;
		trace("select waiting for ".($sout->count())." fds.");
		($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
		trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
		for my $wfd (@$readyw) {
			$readwrote_stuff_this_time = 1;
			if (length($in) != $offset) {
				trace("writing to $wfd.");
				$written = $wfd->syswrite($in, length($in) - $offset, $offset);
				$offset += $written;
			};
			if ($offset == length($in)) {
				trace("writing to $wfd done.");
				unless ($options{'nocloseinput'}) {
					close $wfd;
					trace("$wfd closed.");
				};
				$sin->remove($wfd);
				$sin = undef;
			}
		}

		next unless ($readyr); # Wait some more.

		for my $rfd (@$readyr) {
			$readwrote_stuff_this_time = 1;
			if ($rfd->eof) {
				trace("reading from $rfd done.");
				$sout->remove($rfd);
				close($rfd);
				next;
			}
			trace("reading from $rfd.");
			if ($rfd == $stdoutfd) {
				$stdout .= <$rfd>;
				trace2("stdout is now $stdout\n================");
				next;
			}
			if (defined $statusfd && $rfd == $statusfd) {
				$status .= <$rfd>;
				trace2("status is now $status\n================");
				next;
			}
			if ($rfd == $stderrfd) {
				$stderr .= <$rfd>;
				trace2("stderr is now $stderr\n================");
				next;
			}
		}
	}
	trace("readwrite_gpg done.");
	return ($stdout, $stderr, $status);
};

sub ask($$;$$) {
	my ($question, $default, $forceyes, $forceno) = @_;
	my $answer;
	my $yn = $default ? '[Y/n]' : '[y/N]';
	while (1) {
		print $question,' ',$yn, ' ';
		if ($forceyes && $forceno) {
			print "$default (from config/command line)\n";
			return $default;
		};
		if ($forceyes) {
			print "YES (from config/command line)\n";
			return 1;
		};
		if ($forceno) {
			print "NO (from config/command line)\n";
			return 0;
		};

		$answer = <TTY>;
		chomp $answer;
		last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
		print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
		sleep 1;
	};
	my $result = $default;
	$result = 1 if $answer =~ /y/i;
	$result = 0 if $answer =~ /n/i;
	return $result;
};





my $KEYEDIT_PROMPT = qr/GET_LINE keyedit\.prompt/;
my $KEYEDIT_DELUID_PROMPT = qr/GET_BOOL keyedit\.remove\.uid\.okay/;
my $KEYEDIT_DELSIG_PROMPT = qr/GET_BOOL keyedit\.delsig\.(?:unknown|invalid|valid)/; # we won't delete selfsigs
my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = qr/$KEYEDIT_PROMPT|$KEYEDIT_DELSIG_PROMPT/;
my $KEYEDIT_DELSUBKEY_PROMPT = qr/GET_BOOL keyedit\.remove\.subkey\.okay/;
my $KEYEDIT_SIGNUID_CLASS_PROMPT = qr/GET_LINE sign_uid\.class/;
my $KEYEDIT_SIGNUID_PROMPT = qr/GET_BOOL sign_uid\.okay/;

load_config;
my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";

my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';

-d $KEYSBASE  || make_path($KEYSBASE , {mode => 0700}) or die ("Cannot create $KEYSBASE: $!\n");
-d $GNUPGHOME || make_path($GNUPGHOME, {mode => 0700}) or die ("Cannot create $GNUPGHOME: $!\n");

my $NOW = time;
my  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);


sub version($) {
	my ($fd) = @_;
	print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
};

sub usage($$) {
	my ($fd, $exitcode) = @_;
	version($fd);
	print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
	print $fd "Consult the manual page for more information.\n";
	exit $exitcode;
};

######
# export keys @$keyids from $gnupghome.  In list context, fork and
# return the pid and the file descriptor of its standard output;
# otherwise, wait until the export is done and return the ASCII key.
#
# /!\ Failure to export a key will not be detected, unless *all* keys
# 	  couldn't be exported.  Therefore for safe export/import, you need
# 	  to inspect '$asciikey' or the status FD on the import side.
######
sub export_keys($$@) {
	my ($gnupghome, $keyids, @export_options) = @_;

	my %h = ( 'meta_interactive' => 0
			, 'always_trust' => 1
			, 'extra_args' => [ qw{ --no-auto-check-trustdb } ]
			, 'armor' => wantarray ? 0 : 1 ); # don't armor when piping since it's faster
	$h{'homedir'} = $gnupghome if defined $gnupghome;

	push @export_options, 'export-local-sigs' if $CONFIG{'gpg-sign-type'} =~ /l/;
	push @{$h{'extra_args'}}, '--min-cert-level=1' if grep { $_ eq 'export-clean' } @export_options;
	push @{$h{'extra_args'}}, '--export-options', join (',', @export_options) if @export_options;

	my $gpg = GnuPG::Interface->new();
	$gpg->call( $CONFIG{'gpg'} );
	$gpg->options->hash_init( %h );

	my $handles = make_gpg_fds( stdin => $NULL, stdout => undef, stderr => \*STDERR );
	my $pid = $gpg->export_keys( handles => $handles, command_args => $keyids );

	if (wantarray) {
		return ($pid, $handles->{stdout});
	} else {
		my $stdout = $handles->{stdout};
		my $asciikey = do { local $/; <$stdout> };
		waitpid $pid, 0;
		close $stdout;
		return $asciikey;
	}
};


######
# Create an email to $address.  If $can_encrypt is true then the mail
# will be PGP/MIME encrypted to $longkeyid.
#
# $longkeyid, $uid, and @attached will be used in the email and the template.
######
# create_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
sub create_mail($$$@) {
	my ($address, $can_encrypt, $key_id, @keys) = @_;

	my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
	    or die "Error creating template: $Text::Template::ERROR";

	my $message = $template->fill_in(HASH => { key => $key_id,
						   uids => [ map {$_->{'text'}} @keys ],
						   owner => $CONFIG{'owner'}})
	    or die "Error filling template in: $Text::Template::ERROR";

	my $message_entity = MIME::Entity->build(
		Type        => "text/plain",
		Charset     => "utf-8",
		Disposition => 'inline',
		Data        => Encode::encode_utf8($message));

	my @key_entities;
	for my $key (@keys) {
		$message_entity->attach(
			Type        => "application/pgp-keys",
			Disposition => 'attachment',
			Encoding    => "7bit",
			Description => "PGP Key 0x$key_id, uid ".Encode::encode_utf8($key->{'text'}).' ('.$key->{'serial'}.'), signed by 0x'.$CONFIG{'keyid'}[0],
			Data        => $key->{'key'},
			Filename    => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
	};

	if ($can_encrypt) {
		my $message = $message_entity->stringify();
		my $gpg = GnuPG::Interface->new();
		$gpg->call( $CONFIG{'gpg'} );
		$gpg->options->hash_init( 'homedir' => $GNUPGHOME,
			'meta_interactive' => 0,
			'always_trust' => 1,
			'extra_args' => [ qw{ --no-auto-check-trustdb --textmode } ],
			'armor' => 1 );
		my $handles = make_gpg_fds( map {$_ => undef} qw/stdin stdout stderr status/ );
		$gpg->options->push_recipients( $key_id );
		if (defined $CONFIG{'also-encrypt-to'}) {
			$gpg->options->push_recipients($_) foreach @{$CONFIG{'also-encrypt-to'}};
		}
		my $pid = $gpg->encrypt(handles => $handles);
		my ($stdout, $stderr, $status) = readwrite_gpg($message, $handles);
		waitpid $pid, 0;
		if ($stdout eq '') {
			if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)$/m) and
			    (defined $CONFIG{'also-encrypt-to'})) {
				my $reason = $1;
				my $keyid = $2;
				if (grep { $_ eq $keyid } @{$CONFIG{'also-encrypt-to'}}) {
					warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
					     "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
					     "or try the following if you are slightly more daring:\n".
					     " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
					return;
				};
			};
			warn ("No data from gpg for encrypting mail.  STDERR was:\n$stderr\nstatus output was:\n$status\n");
			return;
		};
		$message = $stdout;

		$message_entity = MIME::Entity->build(
			Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"',
			Encoding    => '7bit');

		$message_entity->attach(
			Type        => "application/pgp-encrypted",
			Filename    => "signedkey.msg",
			Disposition => 'attachment',
			Encoding    => "7bit",
			Data        => "Version: 1\n");
			
		$message_entity->attach(
			Type        => "application/octet-stream",
			Filename    => 'msg.asc',
			Disposition => 'inline',
			Encoding    => "7bit",
			Data        => $message);
	};

	$message_entity->head->add("From", Encode::encode('MIME-Q', $CONFIG{'owner'}).' <'.$CONFIG{'email'}.'>');
	$message_entity->head->add("Date", strfCtime("%a, %e %b %Y %H:%M:%S %z", localtime));
	$message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
	$message_entity->head->add("To", email_to_ascii($address));
	$message_entity->head->add("Sender", Encode::encode('MIME-Q', $CONFIG{'owner'}).' <'.$CONFIG{'email'}.'>');
	$message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
	$message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
	$message_entity->head->add("User-Agent", $USER_AGENT);
	return $message_entity;
};

######
# send a mail message (MIME::Entity)
######
my $warned_about_broken_mailer_send = 0;
sub send_message($) {
	my ($message_entity) = @_;

	if ( (scalar @{$CONFIG{'mailer-send'}} > 0) && !$warned_about_broken_mailer_send) {
		mywarn("You have set arguments to pass to Mail::Mailer.  Better fix your MTA.  (Also, Mail::Mailer's error reporting is non existant, so it won't tell you when it doesn't work.)");
		$warned_about_broken_mailer_send = 1;
	};
	$message_entity->send(@{$CONFIG{'mailer-send'}});
};

# Net::IDN::Encode::email_to_ascii crashes upon punycode conversion failure:
# we don't want caff to crash, so upon errors return the input as is and
# let the MUA handle that
sub email_to_ascii($) {
    my $email = shift;
    my $res;

    eval { $res = Net::IDN::Encode::email_to_ascii($email) };
    return $res unless $@;

    chomp $@;
    mywarn($@);
    return $email;
}

######
# clean up a UID so that it can be used on the FS.
######
sub sanitize_uid($) {
	my ($uid) = @_;

	my $good_uid = $uid;
	$good_uid =~ tr#/:\\#_#;
	trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
	return $good_uid;
};

sub delete_signatures($$$$) {
	my ($handles, $longkeyid, $uid, $keyids) = @_;

	readwrite_gpg("uid 0\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark all uids from delsig
	readwrite_gpg("uid $uid\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark $uid for delsig

	my $last_signed_on = 0;
	my %signers;

	my ($stdout, $stderr, $status) =
		readwrite_gpg("delsig\n", $handles, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);

	while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
		# sig:?::17:EA2199412477CAF8:1058095214:::::13x
		my @sigline = grep { /^sig:/ } (split /\n/, $stdout);
		my $answer = "no";
		if (!@sigline) {
			debug("[sigremoval] no sig line here, only got:\n".$stdout);
		}
		else { # only if we found a sig here - we never remove revocation packets for instance
			my $sig = pop @sigline;
			$sig =~ /^sig:(?:[^:]*:){3}([0-9A-F]{16}):(\d+):(?:[^:]*:){4}(1[0-3]|30)[lx](?::.*)?$/ or
				mywarn("I hit a bug, please report. Couldn't parse sigline $sig.");
			debug("[sigremoval] doing sigline $sig.");
			if ($1 eq $longkeyid) {
				debug("[sigremoval] selfsig ($1).");
				$answer = "no";
			} elsif (grep { $1 eq $_ } @$keyids and $3 != 30) {
				debug("[sigremoval] signed by us ($1).");
				$answer = "no";
				$last_signed_on = $2 if $last_signed_on < $2;
				$signers{$1} = $3-10;
			} else {
				debug("[sigremoval] not interested in that sig ($1).");
				$answer = "yes";
			};
			mywarn("I hit a bug, please report. Found the following ".($#sigline+2)." siglines in that part of the dialog:\n".$stdout) if @sigline;
		}
		($stdout, $stderr, $status) =
			readwrite_gpg($answer."\n", $handles, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
	};

	return ($last_signed_on, \%signers);
};

##
# Check the local user keys.
#
# This function checks if the keyids defined through the --local-user
# command line option or set in ~/.caffrc are valid and known to be one of the
# keyids listed in ~/.caffrc.
#
# @return an array containing the local user keys\n
#         (undef) if no valid key has been found
#
sub get_local_user_keys() {
	my @local_user;
	
	# No user-defined key id has been specified by the user, no need for
	# further checks
	return undef unless $CONFIG{'local-user'};
	
	# Parse the list of keys
	my @key_list = ref $CONFIG{'local-user'} ?  @{$CONFIG{'local-user'}} : split /\s*,\s*/, $CONFIG{'local-user'};

	# Check every key defined by the user...
	for my $user_key (@key_list) {
		
		unless ($user_key =~ m/^((?:0x)?\p{AHex}{8}|(?:0x)?\p{AHex}{16}|\p{AHex}{40}|(?:\p{AHex}{4} ){5}(?: \p{AHex}{4}){5})$/) {
			mywarn "Local-user $user_key is not a valid keyid.";
			next;
		}
		
		$user_key =~ s/^0x//;
		$user_key =~ y/ //d;
		$user_key = uc $user_key;

		unless (grep {$user_key =~ /$_$/} @{$CONFIG{'keyid'}}) {
			mywarn "Local-user $user_key is not defined as one of your keyid in ~/.caffrc (it will not be used).";
			next;
		}
		
		push @local_user, $user_key;
	}

	# If no local-user key are valid, there is no need to go further
	myerror	(1, "None of the local-user keys seem to be known as a keyid listed in ~/.caffrc.") unless defined $local_user[0];
	return @local_user;
}

##
# Import keys from a gnupghome to another.
#
# @param keyids         keyids of the OpenPGP keys to import
# @param src_gnupghome  gnupghome directory where to export the key from
# @param dst_gnupghome  gnupghome directory where to import the key into
# @param export_options an array of export-options, see gpg(1)
#
# @ In list context, return the list of keyids that couldn't be
# imported. In scalar context, return 0 if all keys were imported, and 1
# otherwise.
#
sub import_keys_from_gnupghome($$$@) {
	my ($keyids, $src_gpghome, $dst_gpghome, @export_options) = @_;
	my %keyids = map { $_ => 1} @$keyids;

	# export the (non-armored) keys to $pipe
	trace("Exporting key(s) ".(join ',', @$keyids)." from ".
			($src_gpghome // "your normal GnuPGHOME")." to ".($dst_gpghome // "your normal GnuPGHOME").".");
	my ($ePid, $pipe) = export_keys($src_gpghome, $keyids, @export_options);

	my %h = ( 'meta_interactive' => 0
			, 'quiet' => 1
			, 'always_trust' => 1
			, 'extra_args' => [ qw{ --no-auto-check-trustdb } ] );
	$h{homedir} = $dst_gpghome if defined $dst_gpghome;
	push @{$h{'extra_args'}}, qw/--import-options import-local-sigs/ if $CONFIG{'gpg-sign-type'} =~ /l/;

	my $gpg = GnuPG::Interface->new();
	$gpg->call( $CONFIG{'gpg'} );
	$gpg->options->hash_init( %h );

	# import keys from $pipe
	my $handles = make_gpg_fds( stdin => $pipe, stdout => $NULL, stderr => \*STDERR, status => undef );
	my $iPid = $gpg->import_keys( handles => $handles );

	# inspect the $status FD as data gets out.
	my $status = $handles->{status};
	while (<$status>) {
		if (defined wantarray and /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})$/) {
			my $fpr = $1;
			my @keys = grep { $fpr =~ /$_$/ } @$keyids;
			mywarn ("Multiple (".($#keys+1).") keys matched $fpr in ".($src_gpghome // "your normal GnuPGHOME").".")
				if $#keys > 0;
			delete @keyids{@keys};
		}
	}
	waitpid $iPid, 0; # import done
	waitpid $ePid, 0; # export done
	close $handles->{$_} for qw/stdin status/;

	if (wantarray) {
		return (keys %keyids); # failed to import
	} elsif (defined wantarray) {
		# scalar context
		return %keyids ? 1 : 0;
	}
	# void context
}

##
# Import a key file into a specified gnupghome.
#
# @param keyfile       file containing the keys to import
# @param dst_gnupghome gnupghome directory where to import the key
#
# @return 0 if successful\n
#         1 if an error occured.
#
sub import_key_files($$) {
	my ($keyfile, $dst_gpghome) = @_;

	my %h = ( 'meta_interactive' => 0
			, 'quiet' => 1
			, 'always_trust' => 1
			, 'extra_args' => [ qw{ --no-auto-check-trustdb } ] );
	$h{homedir} = $dst_gpghome if defined $dst_gpghome;
	push @{$h{'extra_args'}}, qw/--import-options import-local-sigs/ if $CONFIG{'gpg-sign-type'} =~ /l/;

	my $gpg = GnuPG::Interface->new();
	$gpg->call( $CONFIG{'gpg'} );
	$gpg->options->hash_init( %h );

	my $handles = make_gpg_fds( stdin => $NULL, stdout => $NULL, stderr => \*STDERR, status => undef );
	my $pid = $gpg->import_keys( handles => $handles, command_args => $keyfile );

	my $err = 1;
	my $status = $handles->{status};
	while (<$status>) {
		if (/^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})$/) {
			info("Key $1 imported from $keyfile.");
			$err = 0;
		}
	}
	waitpid $pid, 0;
	close $status;
	return $err;
}

##
# Import keys to be signed into caff gnupghome directory.
#
# This function imports the keys the user wants to sign into the caff gnupghome
# directory. We looks for the keys in the the user gnupghome directory first,
# and in the key files specified by the user if not all of the keys have been
# found.
#
sub import_keys_to_sign() {
	# Check if we can find the gpg key from our normal gnupghome, and then
	# try to import it into our working gnupghome directory
	if ($CONFIG{'keys-from-gnupg'}) {
		my @failed = import_keys_from_gnupghome(\@KEYIDS, undef, $GNUPGHOME);
		foreach my $keyid (@KEYIDS) {
			info("Key $keyid imported from your normal GnuPGHOME.")
				unless grep { $keyid eq $_ } @failed;
		}
	};

	# Import user specified key files
	foreach my $keyfile (@{$CONFIG{'key-files'}}) {
		import_key_files($keyfile, $GNUPGHOME);
	}

	return 0;
}

##
# A non-localized version of POSIX::strftime.
#
sub strfCtime($@) {
    my $lc_time = setlocale(POSIX::LC_TIME);
    setlocale(POSIX::LC_TIME, 'C');
    my $str = strftime(@_);
    setlocale(POSIX::LC_TIME, $lc_time);
    return $str;
}


###################
# argument handling
###################
Getopt::Long::config('bundling');
if (!GetOptions (
	'-h'                =>  \$params->{'help'},
	'--help'            =>  \$params->{'help'},
	'--version'         =>  \$params->{'version'},
	'-V'                =>  \$params->{'version'},
	'-u=s'              =>  \$params->{'local-user'},
	'--local-user=s'    =>  \$params->{'local-user'},
	'-e'                =>  \$params->{'export-old'},
	'--export-old'      =>  \$params->{'export-old'},
	'-E'                =>  \$params->{'no-export-old'},
	'--no-export-old'   =>  \$params->{'no-export-old'},
	'-m:s'              =>  \$params->{'mail'},
	'--mail:s'          =>  \$params->{'mail'},
	'-M'                =>  \$params->{'no-mail'},
	'--no-mail'         =>  \$params->{'no-mail'},
	'-R'                =>  \$params->{'no-download'},
	'--no-download'     =>  \$params->{'no-download'},
	'-S'                =>  \$params->{'no-sign'},
	'--no-sign'         =>  \$params->{'no-sign'},
	'--key-file=s@'     =>  \$params->{'key-files'},
	'--keys-from-gnupg' =>  \$params->{'keys-from-gnupg'},
	)) {
	usage(\*STDERR, 1);
};
if ($params->{'help'}) {
	usage(\*STDOUT, 0);
};
if ($params->{'version'}) {
	version(\*STDOUT);
	exit(0);
};

if (-t \*STDIN) {
	# we're already talking to a TTY
	usage(\*STDERR, 1) unless @ARGV;
	*TTY = *STDIN;
} else {
	my @checksums;
	my $goodblock;
	my $got_input; # detect xargs, /dev/null, ...
	while (<STDIN>) {
		unless ($got_input) {
			info("Reading gpgparticipants formatted input on STDIN.");
			$got_input = 1;
		}

		if (/^(\S+)\s+Checksum:\s+[_ 0-9A-F]+(?:\s+\[(.)\])?$/i) {
			# ensure the checksum is (claimed to be) verified
			my ($md, $r) = ($1, $2);
			while (!defined $r) {
				$_ = <STDIN>;
				if (/^\s+[_ 0-9A-F]+\s+\[(.)\]$/i) {
					$r = $1;
				}
				elsif (!/^(:?\s+[_ 0-9A-F]+)?$/i) {
					die "Unexpected input line: " .$_. "\n";
				}
			}
			die "$md checksum wasn't marked as verified!\n" unless lc $r eq 'x';
			info "Found $md checksum (marked as verified, assumed good).";
			push @checksums, uc $md;
		}
		elsif (/^(?:-+|_+)$/) {
			$goodblock = 0;
		}
		elsif (/^(#*)(?:\d+)\s+\[(.)\] Fingerprint(?:\(s\)|s)? OK\s+\[(.)\] ID OK\s*$/) {
			$goodblock = (!$1 and lc $2 eq 'x' and lc $3 eq 'x') ? 1 : 0;
		}
		elsif (/^\s+Key fingerprint = ([A-F0-9]{32}|(?:[A-F0-9]{2} ){8}(?: [A-F0-9]{2}){8})$/) {
			info("Ignoring v3 fingerprint ".($1 =~ y/ //dr).".  v3 keys are obsolete.");
		}
		elsif (/^\s+Key fingerprint = ([A-F0-9]{40}|(?:[A-F0-9]{4} ){5}(?: [A-F0-9]{4}){5})$/) {
			my $fpr = ($1 =~ y/ //dr);
			if ($goodblock) {
				info ("Adding fingerprint $fpr");
				push @KEYIDS, $fpr;
			} else {
				info ("Ignoring fingerprint $fpr");
			}
		}
	}

	if ($got_input) {
		if (!@checksums) {
			mywarn "No checksum found!";
		} elsif (!grep { my $x = $_; grep { $x eq $_ } qw/SHA256 SHA384 SHA512 SHA224/ } @checksums) {
			mywarn "No checksum of the SHA-2 family found!";
		}
	}

	close STDIN;
	open TTY, '<', '/dev/tty' or die "No TTY."
}

for my $hashkey (qw{local-user no-download no-sign no-mail mail keys-from-gnupg}) {
	$CONFIG{$hashkey} = $params->{$hashkey}  if defined $params->{$hashkey};
};
# If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
if ( defined $CONFIG{'no-mail'} || 
     ( defined $CONFIG{'mail'} && $CONFIG{'mail'}  eq 'no' ) ) {
	$CONFIG{'mail'} = 'no';

} elsif ( !defined $CONFIG{'mail'} ) {
	$CONFIG{'mail'} = 'ask-yes';
}
$CONFIG{'mail-cant-encrypt'} //= $CONFIG{'mail'};

push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'};

for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
	if ($keyid =~ /^(\p{AHex}{32}|(?:\p{AHex}{2} ){8}(?: \p{AHex}{2}){8})$/) {
		info("Ignoring v3 fingerprint ".($keyid =~ y/ //dr).".  v3 keys are obsolete.");
		next;
	}
	elsif ($keyid !~ /^((?:0x)?\p{AHex}{8}|(?:0x)?\p{AHex}{16}|\p{AHex}{40}|(?:\p{AHex}{4} ){5}(?: \p{AHex}{4}){5})$/) {
		print STDERR "$keyid is not a keyid.\n";
		usage(\*STDERR, 1);
	};

	$keyid =~ s/^0x//;
	$keyid =~ y/ //d; # gpg --fingerprint includes spaces
	push @KEYIDS, uc($keyid);
};

#################
# import own keys
#################
import_keys_from_gnupghome(\@{$CONFIG{'keyid'}}, undef, $GNUPGHOME) and
	die "Not all keys in '\$CONFIG{'keyid'}' could be imported from your normal GnuPGHOME.\n";

import_keys_to_sign();

#############################
# receive keys from keyserver
#############################
my @keyids_ok;
if ($CONFIG{'no-download'}) {
	@keyids_ok = @KEYIDS;
} else {
	unless (defined $CONFIG{'keyserver'}) {
		my $gpgconf = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/gpg.conf';
		if (-e $gpgconf and open my $fh, $gpgconf) {
			my @keyservers = map { chomp; s/^\s*keyserver\s+//r } (grep {/^\s*keyserver\s/} <$fh>);
			$CONFIG{'keyserver'} = $keyservers[$#keyservers] if @keyservers;
			close $fh;
		}
	}
	$CONFIG{'keyserver'} //= 'pool.sks-keyservers.net';
	info ("Fetching keys from $CONFIG{keyserver}, this may take a while...");

	my $gpg = GnuPG::Interface->new();
	$gpg->call( $CONFIG{'gpg'} );
	$gpg->options->hash_init(
		'homedir' => $GNUPGHOME,
		'meta_interactive' => 0,
		'always_trust' => 1,
		'extra_args' => [ qw{ --no-auto-check-trustdb }, '--keyserver='.$CONFIG{'keyserver'} ] );

	# logger: requesting key ... from hkp
	# stdout: gpgkeys: key ... not found on keyserver
	my $handles = make_gpg_fds( (map {$_ => $NULL} qw/stdin stdout logger/), stderr => \*STDERR, status => undef );
	my $pid = $gpg->recv_keys(handles => $handles, command_args => \@KEYIDS);

# [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
# [GNUPG:] NODATA 1
# [GNUPG:] NODATA 1
# [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
	my %local_keyids = map { $_ => 1 } @KEYIDS;
	my $had_v3_keys = 0;
	my $status = $handles->{status};
	while (<$status>) {
		if (/^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})$/) {
			my $imported_key = $1;
			my $whole_fpr = $imported_key;
			my $long_keyid = substr($imported_key, -16);
			my $short_keyid = substr($imported_key, -8);
			my $speced_key;
			for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
				$speced_key = $spec if $local_keyids{$spec};
			};
			unless ($speced_key) {
			    notice ("Imported unexpected key; got: $imported_key\nAre you trying to work on a subkey?");
			    next;
			};
			debug ("Imported $imported_key for $speced_key");
			delete $local_keyids{$speced_key};
			unshift @keyids_ok, $imported_key;
		} elsif (/^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})$/) {
			my $imported_key = $1;
			notice ("Imported v3 key $1.  Version 3 keys are obsolete, should not be used, and are not and will not be properly supported.");
			$had_v3_keys = 1;
		} elsif (!/^\[GNUPG:\] (?:NODATA|IMPORT_RES|IMPORTED) /) {
			notice ("Got unknown reply from gpg: ".$_);
		}
	};
	waitpid $pid, 0;
	close $status;

	if (scalar %local_keyids) {
		notice ("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ? " (Or maybe it's one of those ugly v3 keys?)" :  ""));
		exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
		if (scalar keys %local_keyids == 1) {
			mywarn("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
		} else {
			mywarn("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
		};
		push @keyids_ok, keys %local_keyids;
	}
};

if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
	$CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
}

my @LOCAL_USER;
@LOCAL_USER = get_local_user_keys() unless $CONFIG{'no-sign'};

my %KEYS;
for my $keyid (@keyids_ok) {
	# get key listing (and ensure there is no collision)
	####################################################
	my $gpg = GnuPG::Interface->new();
	$gpg->call( $CONFIG{'gpg'} );
	$gpg->options->hash_init(
		'homedir' => $GNUPGHOME,
		'meta_interactive' => 0,
		'always_trust' => 1,
		'extra_args' => [ qw{ --no-auto-check-trustdb --fingerprint --with-colons --fixed-list-mode } ] );

	my $handles = make_gpg_fds( stdin => $NULL, stdout => undef, stderr => $NULL );
	# process the keys one by one so we can detect collisions
	my $pid = $gpg->list_public_keys( handles => $handles, command_args => [$keyid] );

	my $stdout = $handles->{stdout};
	while (<$stdout>) {
		if (/^pub:([^:]+):(?:[^:]*:){2}([0-9A-F]{16}):(?:[^:]*:){6}([^:]+)/) {
			if (exists $KEYS{$keyid}) {
				mywarn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint.");
				last;
			} elsif ($1 =~ /[eir]/ or $3 =~ /D/ ) {
				mywarn ("Ignoring unusable key $keyid.");
				last;
			}
			$KEYS{$keyid} = { longkeyid => $2, flags => $3, uids => [], subkeys => [] };
		}
		elsif (/^fpr:(?:[^:]*:){8}([0-9A-F]{40})(?::.*)?$/) {
			$KEYS{$keyid}->{fpr} = $1;
		}
		elsif (/^fpr:(?:[^:]*:){8}([0-9A-F]{32})(?::.*)?$/) {
			info("Ignoring v3 key $keyid.  v3 keys are obsolete.");
			delete $KEYS{$keyid};
			last;
		}
		elsif (/^sub:[^:]+:(?:[^:]*:){2}([0-9A-F]{16}):/) {
			push @{$KEYS{$keyid}->{subkeys}}, $1;
		}
		elsif (/^(uid|uat):([^:]+):(?:[^:]*:){5}([0-9A-F]{40}):[^:]*:([^:]+)/) {
			my $uid = { type => $1
				      , validity => $2
				      , hash => $3
				      , text => $1 eq 'uid' ? $4 : '[attribute]'
			};
			$uid->{text} =~ s/\\x(\p{AHex}{2})/ chr(hex($1)) /ge;
			# --with-colons always outputs UTF-8
			$uid->{text} = Encode::decode_utf8($uid->{text});
			push @{$KEYS{$keyid}->{uids}}, $uid;
		}
		elsif (!/^(?:rvk|tru):/) {
			chomp;
			notice ("Got unknown reply from gpg: ".$_);
		}
	}
	waitpid $pid, 0;
	close $stdout;

	unless (defined $KEYS{$keyid}) {
		mywarn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).");
		next;
	}
}

unless (keys %KEYS) {
	notice ("No keys to sign found");
	exit 0;
}


for my $keyid (@keyids_ok) {
	next unless exists $KEYS{$keyid};
	my $longkeyid = $KEYS{$keyid}->{longkeyid};

	###########
	# sign keys
	###########
	unless ($CONFIG{'no-sign'}) {
		info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
		foreach my $local_user (@LOCAL_USER) {
			my @command;
			push @command, $CONFIG{'gpg-sign'};
			push @command, '--local-user', $local_user if defined $local_user;
			push @command, "--homedir=$GNUPGHOME";
			push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
			push @command, qw/--no-auto-check-trustdb --trust-model=always/;
			push @command, '--edit-key', $keyid;
			push @command, 'showphoto' if $CONFIG{'show-photos'};
			push @command, $CONFIG{'gpg-sign-type'}.'sign';
			push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
			print join(' ', @command),"\n";
			system @command;
			die "$CONFIG{'gpg-sign'} exited with value $?.\n" if 0 < $? and $? <= 2;
		};
	};


	##################
	# export and prune
	##################

	# export the key
	################
	my $keydir = File::Temp->newdir( "caff-$keyid-XXXXX", TMPDIR => 1 );
	import_keys_from_gnupghome (\@{$CONFIG{'keyid'}}, $GNUPGHOME, $keydir, 'export-minimal') and
		die "Not all keys in '\$CONFIG{'keyid'}' could be imported from caff's GnuPGHOME (with 'export-minimal').\n";
	import_keys_from_gnupghome ([$keyid], $GNUPGHOME, $keydir, 'export-clean') and
		die "$keyid couldn't be imported from caff's GnuPGHOME (with 'export-clean').\n";

	# the first UID. we won't delete that one when pruning for UATs because a key has to have at least one UID
	my @uids = @{$KEYS{$keyid}->{uids}};
	my $first_uid = (grep {$_->{type} eq 'uid'} @uids)[0];

	for (my $uid_number = 1; $uid_number <= $#uids+1; $uid_number++) {
		debug("Doing key $keyid, uid $uid_number");
		my $uid = $uids[$uid_number-1];

		# /!\ this serial is valid in caff's GnuPGHOME only, and can't
		# be relied upon if the keyring is modified in the meantime.
		$uid->{serial} = $uid_number;

		next if $uid->{validity} =~ /[eir]/; # skip expired / invalid / revokey UIDs

		# copy pubring to temporary gpghome
		###################################
		my $uiddir = File::Temp->newdir( "caff-$keyid-$uid_number-XXXXX", TMPDIR => 1 );
		copy("$keydir/pubring.gpg", "$uiddir/pubring.gpg");

		# prune it
		##########
		my $gpg = GnuPG::Interface->new();
		$gpg->call( $CONFIG{'gpg-delsig'} );
		$gpg->options->hash_init(
			'homedir' => $uiddir,
			'command_fd' => 0,
			'always_trust' => 1,
			'extra_args' => [ qw{ --no-auto-check-trustdb --with-colons --fast-list-mode --fixed-list-mode --no-tty } ] );
		my $handles = make_gpg_fds( map {$_ => undef} qw/stdin stdout stderr status/ );
		my $pid = $gpg->wrap_call(
			commands     => [ '--edit-key' ],
			command_args => [ $keyid ],
			handles      => $handles );

		debug("Starting edit session");
		my ($stdout, $stderr, $status) = readwrite_gpg('', $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);

		# delete other uids
		###################
		my $delete_some = 0;
		for (my $i = 1; $i <= $#uids+1; $i++) {
			# it's quicker with gpg2: 'uid *' then 'uid $i'
			next if $i == $uid_number;
			next if $uid->{type} ne 'uid' and $uids[$i-1]->{hash} eq $first_uid->{hash}; # keep the first UID

			debug("Marking UID $i ($uids[$i-1]->{hash}) for deletion.");
			readwrite_gpg("uid $i\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
			$delete_some++;
		}

		if ($delete_some) {
			debug("Need to delete $delete_some uids.");
			readwrite_gpg("deluid\n", $handles, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
			readwrite_gpg("yes\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
		};

		# delete all subkeys
		####################
		if (@{$KEYS{$keyid}->{subkeys}}) {
			for (my $i = 1; $i <= $#{$KEYS{$keyid}->{subkeys}} + 1; $i++) {
				debug("Marking subkey $i ($KEYS{$keyid}->{subkeys}->[$i-1]) for deletion.");
				readwrite_gpg("key $i\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
			};
			readwrite_gpg("delkey\n", $handles, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
			readwrite_gpg("yes\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
		};

		# delete signatures
		###################
		# this shouldn't delete anything as $longkeyid is already clean, but maybe we didn't sign that uid with all keys in @{$CONFIG{'keyid'}}
		my ($last_signed_on, $signers) = delete_signatures($handles, $longkeyid, $uid->{hash}, $CONFIG{'keyid'});

		delete_signatures($handles, $longkeyid, $first_uid->{hash}, [])
			if $uid->{type} ne 'uid'; # delete all sigs on the first UID if $uid is an attribute


		readwrite_gpg("save\n", $handles);
		waitpid $pid, 0;

		my $asciikey = export_keys($uiddir, $keyid);
		undef $uiddir; # delete dir

		unless ($asciikey) {
			warn ("No data from gpg for export $keyid\n");
			next;
		};

		if ($last_signed_on) {
			# it's a bit inefficient to store the $asciikey in memory,
			# but it has been pruned so it's shouldn't be too big
			$uid->{key} = $asciikey;
			$uid->{signers} = $signers;
			$uid->{last_signed_on} = $last_signed_on;
		};
	};
	undef $keydir; # delete dir

	if ($CONFIG{'also-lsign-in-gnupghome'} ne 'no') {
		###############################
		# add non-exportable signatures
		###############################

		import_keys_from_gnupghome( [ $keyid ], $GNUPGHOME, undef,
									# do not export our own exportable signatures, but ensure we've got the same UID list
									$CONFIG{'gpg-sign-type'} =~ /l/ ? () : 'export-minimal' );
		if ( $CONFIG{'gpg-sign-type'} =~ /l/ ) {
			# we've copied the (local) signature to our GnuPHOME and we're done
		}
		elsif ( $CONFIG{'also-lsign-in-gnupghome'} ne 'auto' ) {
			# manually lsign the key
			########################
			foreach my $local_user (@LOCAL_USER) {
				my @command;
				push @command, $CONFIG{'gpg-sign'};
				push @command, '--local-user', $local_user if defined $local_user;
				push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
				push @command, qw/--no-auto-check-trustdb --trust-model=always/;
				push @command, '--edit-key', $keyid;
				push @command, 'showphoto' if $CONFIG{'show-photos'};
				push @command, 'lsign';
				push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
				print join(' ', @command),"\n";
				system @command;
				die "$CONFIG{'gpg-sign'} exited with value $?.\n" if 0 < $? and $? <= 2;
			};
		}
		else {
			# auto lsign the relevant uids
			##############################
			my @uids = grep {$_->{last_signed_on}} @{$KEYS{$keyid}->{uids}};
			my @signers = map {keys %{$_->{signers}}} @uids;
			if (@LOCAL_USER && defined $LOCAL_USER[0]) {
				# which of @LOCAL_USER has signed at least one UID in this key?
				@signers = grep { my $u = $_; grep { $u eq $_ } @signers } @LOCAL_USER;
			} else {
				# no @LOCAL_USER was defined; remove duplicates to avoid double signing
				@signers = keys %{{ map { $_ => 1 } @signers }}
			};

			foreach my $u (@signers) {
				my @signeduids; # uids signed by $u
				foreach my $uid (@uids) {
					# we use UIDs hashes to distinguish and select UIDs; it's the only reliable way to identify them accross keyrings
					push @signeduids, $uid if grep { $u eq $_ } (keys %{$uid->{signers}}) and
											 !grep { $uid->{hash} eq $_->{hash} } @signeduids;
				}

				my $gpg = GnuPG::Interface->new();
				$gpg->call( $CONFIG{'gpg'} );
				$gpg->options->hash_init(
					'command_fd' => 0,
					'always_trust' => 1,
					'extra_args' => [ '--local-user', $u
									, '--secret-keyring', $CONFIG{'secret-keyring'}
									, '--ask-cert-level'
									# we know there is a working agent
									, '--use-agent'
									, qw{ --no-auto-check-trustdb --no-tty } ] );
				my $handles = make_gpg_fds( map {$_ => undef} qw/stdin stdout stderr status/ );
				my $pid = $gpg->wrap_call(
					commands     => [ '--edit-key' ],
					command_args => [ $keyid ],
					handles      => $handles );

				debug("Starting edit session on $keyid, signer $u");
				readwrite_gpg('', $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);

				foreach my $level (0..3) {
					my @signeduids_with_level = grep {$_->{signers}->{$u} eq $level} @signeduids;
					next unless @signeduids_with_level;

					info("lsign-ing (by $u) with cert level $level uid(s) #".(join ',', sort (map {$_->{serial}} @signeduids_with_level))." of $longkeyid.");
					readwrite_gpg("uid 0\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
					readwrite_gpg("uid $_->{hash}\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1)
						for @signeduids_with_level;
					my ($stdout, $stderr, $status) = readwrite_gpg("lsign\n", $handles, exitwhenstatusmatches => qr/$KEYEDIT_SIGNUID_CLASS_PROMPT|$KEYEDIT_PROMPT/, nocloseinput => 1);
					next if $status =~ /^\[GNUPG:\] $KEYEDIT_PROMPT/m; # already signed
					readwrite_gpg("$level\n", $handles, exitwhenstatusmatches => $KEYEDIT_SIGNUID_PROMPT, nocloseinput => 1);
					readwrite_gpg("yes\n", $handles, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
				}

				readwrite_gpg("save\n", $handles);
				waitpid $pid, 0;
			}
		}
	}
	info("key $longkeyid done.");
}

#############
# send emails
#############
for my $keyid (@keyids_ok) {
	next unless exists $KEYS{$keyid};
	my $longkeyid = $KEYS{$keyid}->{longkeyid};
	my $can_encrypt = $KEYS{$keyid}->{flags} =~ /E/;
	my @UIDS = @{$KEYS{$keyid}->{uids}};

	unless (grep {$_->{last_signed_on}} @UIDS) {
		info("found no signed uids for $keyid");
		next;
	}

	my @attached;
	for my $uid (@UIDS) {
		my $text = defined $LOCALE ? $LOCALE->encode($uid->{text}) : $uid->{text};
		trace("UID: $text\n");
		if ($uid->{validity} =~ /[eir]/) {
			my $reason = $uid->{validity} =~ /e/ ? 'expired' :
						 $uid->{validity} =~ /i/ ? 'invalid' :
						 $uid->{validity} =~ /r/ ? 'revoked' : undef;
			info("$longkeyid $uid->{serial} $text is $reason, not writing.");
			next;
		}
		unless ($uid->{last_signed_on}) {
			info("$longkeyid $uid->{serial} $text is not signed by me, not writing.");
			next;
		}

		if ($NOW - $uid->{last_signed_on} > $CONFIG{'export-sig-age'} and
				!ask("Signature on $text is old.  Export?", 0, $params->{'export-old'}, $params->{'no-export-old'})) {
			undef $uid->{last_signed_on}; # won't write, won't send
			next;
		};

		# save the armored key
		my $keydir = "$KEYSBASE/$DATE_STRING";
		-d $keydir || make_path($keydir , {mode => 0700}) or die ("Cannot create $keydir: $!\n");

		my $keyfile = "$keydir/$longkeyid.key.$uid->{serial}.".sanitize_uid($text).".asc";
		open my $KEY, '>', $keyfile or die "Cannot open $keyfile: $!\n";
		print $KEY $uid->{key};
		close $KEY;

		if ($uid->{type} eq 'uat') {
			my $attach = ask("UID $text is an attribute UID, attach it to every email?", 1);
			push @attached, $uid if $attach;
		} elsif ($uid->{'text'} =~ /.*<([^>]+[\@\N{U+FE6B}\N{U+FF20}][^>]+)>$/) {
			# XXX This does not cover the full RFC 2822 specification:
			# The local part may contain '>' in a quoted string.
			# However as of 1.4.18/2.0.26, gpg doesn't allow that either.
			$uid->{'address'} = $1;
		} else {
			my $attach = ask("UID $text is no email address, attach it to every email?", 1);
			push @attached, $uid if $attach;
		};

		info("$longkeyid $uid->{serial} $text done.");
	};

	notice("Key has no encryption capabilities, mail(s) will be sent/stored unencrypted") unless $can_encrypt;
	my $sendmail = $can_encrypt ? $CONFIG{'mail'} : $CONFIG{'mail-cant-encrypt'};
	for my $uid (@UIDS) {
		next unless $uid->{last_signed_on}; # wasn't signed by me
		next unless defined $uid->{address};

		my $mail = create_mail($uid->{address}, $can_encrypt, $longkeyid, $uid, @attached);
		if (defined $mail) {
			my $text = defined $LOCALE ? $LOCALE->encode($uid->{text}) : $uid->{text};
			my $should_send_mail = ask("Mail ".($can_encrypt ? '' : '*unencrypted* ')."signature for $text to '$uid->{address}'?",
									   $sendmail ne 'ask-no', $sendmail eq 'yes', $sendmail eq 'no');
			send_message($mail) if $should_send_mail;

			my $keydir = "$KEYSBASE/$DATE_STRING";
			my $mailfile = "$keydir/$longkeyid.mail.".($should_send_mail ? '' : 'unsent.').$uid->{'serial'}.".".sanitize_uid($text);
			open my $MAILFILE, '>', $mailfile or die "Cannot open $mailfile: $!\n";
			$mail->print($MAILFILE);
			close $MAILFILE;
		} else {
			warn "Generating mail failed.\n";
		};
	};
};

###########################
# the default mail template
###########################

__DATA__
Hi,

please find attached the user id{(scalar @uids >= 2 ? 's' : '')}
{foreach $uid (@uids) {
    $OUT .= "\t".$uid."\n";
};}of your key {$key} signed by me.

If you have multiple user ids, I sent the signature for each user id
separately to that user id's associated email address. You can import
the signatures by running each through `gpg --import`.

Note that I did not upload your key to any keyservers. If you want this
new signature to be available to others, please upload it yourself.
With GnuPG this can be done using
	gpg --keyserver pool.sks-keyservers.net --send-key {$key}

If you have any questions, don't hesitate to ask.

Regards,
{$owner}