# caff -- CA - Fire and Forget
# $Id$
#
-# Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
+# Copyright (c) 2004, 2005, 2006 Peter Palfrader <peter@palfrader.org>
+# Copyright (c) 2005, 2006 Christoph Berg <cb@df7cb.de>
#
# All rights reserved.
#
=over
-=item B<caff> [-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<keyid> ..]
=back
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.
+sigs and sigs done by you. The mailed key is encrypted with itself as a means
+to verify that key belongs to the recipient.
=head1 OPTIONS
=over
-=item B<-u> I<yourkeyid>
+=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.
=back
=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} ];
+ $CONFIG{'owner'} = q{Peter Palfrader};
+ $CONFIG{'email'} = q{peter@palfrader.org};
+ $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
-=head2 Valid keys
+=head2 Required basic settings
=over
-=item B<caffhome> [string]
-
-Base directory for the files caff stores. Default: B<$HOME/.caff/>.
-
=item B<owner> [string]
Your name. B<REQUIRED>.
in the pruning step. If you select a key using B<-u> it has to be in
this list. B<REQUIRED>.
-=item B<export-sig-age> [seconds]
+=back
-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).
+=head2 General settings
-=item B<keyserver> [string]
+=over
+
+=item B<caffhome> [string]
+
+Base directory for the files caff stores. Default: B<$HOME/.caff/>.
+
+=back
-Keyserver to download keys from. Default: B<subkeys.pgp.net>.
+=head2 GnuPG settings
+
+=over
=item B<gpg> [string]
=item B<gpg-delsig> [string]
-Path to the GnuPG binary which is used to split off signatures. This is
-needed while the upstream GnuPG is not fixed (there are 2 bugs in the
-Debian Bug Tracking System). Default: what B<gpg> is set to.
+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]
+=item B<also-encrypt-to> [keyid, or list of keyids]
+
+Additional keyids to encrypt messages to. Default: none.
+
+=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]
-An additional keyid to encrypt messages to. Default: none.
+Keyserver to download keys from. Default: 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.
+
+=back
+
+=head2 Mail settings
+
+=over
+
+=item B<mail> [boolean]
+
+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-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
+
+=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', '-o8' ];
+
+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 AUTHOR
+=head1 AUTHORS
+
+=over
-Peter Palfrader <peter@palfrader.org>
+=item Peter Palfrader <peter@palfrader.org>
+
+=item Christoph Berg <cb@df7cb.de>
+
+=back
=head1 WEBSITE
http://pgp-tools.alioth.debian.org/
+=head1 SEE ALSO
+
+gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
+
=cut
use strict;
use English;
use File::Path;
use File::Temp qw{tempdir};
+use Text::Template;
use MIME::Entity;
+use Encode;
use Fcntl;
use IO::Select;
+use Getopt::Long;
use GnuPG::Interface;
my %CONFIG;
my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
my $VERSION = "0.0.0.$REVISION_NUMER";
-sub load_config() {
- my $config = $ENV{'HOME'} . '/.caffrc';
- -f $config or die "No file $config present. See caff(1).\n";
- unless (scalar eval `cat $config`) {
- die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
- };
- $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
- die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
- die ("email is not defined.\n") unless defined $CONFIG{'email'};
- die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
- die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
- for my $keyid (@{$CONFIG{'keyid'}}) {
- $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
- };
- @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
- $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
- $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
- $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
- $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
- $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
- $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
- $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
- $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
+##
+# 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";
#print "[trace2] $line\n";
};
+
+sub generate_config() {
+ notice("Error: \$LOGNAME is not set.\n") 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(
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
+ $gpg->options->meta_interactive( 0 );
+ my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
+ my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $gecos ]);
+ my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
+ 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,2}([^:]+):/mg);
+ unless (scalar @keys) {
+ info("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
+ @keys = qw{0123456789abcdef 89abcdef76543210};
+ $Ckeys = '#';
+ }
+ ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/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 --with-colons --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' unless defined $CONFIG{'caffhome'};
+ 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 =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
+ };
+ @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
+ $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
+ $CONFIG{'keyserver'} = 'pool.sks-keyservers.net' unless defined $CONFIG{'keyserver'};
+ $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
+ $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
+ $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
+ check_executable("gpg", $CONFIG{'gpg'});
+ check_executable("gpg-sign", $CONFIG{'gpg-sign'});
+ check_executable("gpg-delsig", $CONFIG{'gpg-delsig'});
+ $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
+ unless defined $CONFIG{'secret-keyring'};
+ $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
+ $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
+ $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
+ $CONFIG{'mailer-send'} = [] unless defined $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>;
+ }
+ if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
+ $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
+ };
+};
+
sub make_gpg_fds() {
my %fds = (
stdin => IO::Handle->new(),
trace("Entering readwrite_gpg.");
- my ($first_line, $dummy) = split /\n/, $in;
+ my ($first_line, undef) = split /\n/, $in;
debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
local $INPUT_RECORD_SEPARATOR = undef;
return ($stdout, $stderr, $status);
};
-sub ask($$) {
- my ($question, $default) = @_;
+sub ask($$;$$) {
+ my ($question, $default, $forceyes, $forceno) = @_;
my $answer;
+ my $yn = $default ? '[Y/n]' : '[y/N]';
while (1) {
- print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
+ 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 = <STDIN>;
+ if (!defined $answer) {
+ $OUTPUT_AUTOFLUSH = 1;
+ die "\n\n".
+ "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
+ "so you can't really use it with xargs. A patch against caff to read from\n".
+ "the terminal would be appreciated.\n".
+ "For now instead of cat keys | xargs caff do caff `cat keys`\n";
+ };
chomp $answer;
- last if ((defined $answer) && (length $answer <= 1));
- print "grrrrrr.\n";
+ 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;
my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
load_config;
-my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader";
+my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
-sub usage() {
- print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
- print STDERR "Usage: $PROGRAM_NAME [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
- exit 1;
+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 key $keyid from $gnupghome
+######
sub export_key($$) {
my ($gnupghome, $keyid) = @_;
my $gpg = GnuPG::Interface->new();
$gpg->call( $CONFIG{'gpg'} );
- $gpg->options->hash_init(
- 'homedir' => $gnupghome,
- 'armor' => 1 );
+ if (defined $gnupghome) {
+ $gpg->options->hash_init(
+ 'homedir' => $gnupghome,
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
+ 'armor' => 1 );
+ } else {
+ $gpg->options->hash_init(
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
+ 'armor' => 1 );
+ };
$gpg->options->meta_interactive( 0 );
my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
return $stdout;
};
+######
+# import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
+######
+sub import_key($$) {
+ my ($gnupghome, $asciikey) = @_;
+
+ my $gpg = GnuPG::Interface->new();
+ $gpg->call( $CONFIG{'gpg'} );
+ $gpg->options->hash_init(
+ 'homedir' => $gnupghome,
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] );
+ $gpg->options->meta_interactive( 0 );
+ my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
+ my $pid = $gpg->import_keys(handles => $handles);
+ my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
+ waitpid $pid, 0;
+
+ if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
+ return undef;
+ };
+ return 1;
+};
+
+
+######
+# Send 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.
+######
#send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
sub send_mail($$$@) {
my ($address, $can_encrypt, $key_id, @keys) = @_;
- my $message = "Hi,\n\n";
+ my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
+ or die "Error creating template: $Text::Template::ERROR";
- $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n";
+ my @uids;
for my $key (@keys) {
- $message .= "\t".$key->{'text'}."\n";
+ push @uids, $key->{'text'};
};
- $message .= qq{of your key $key_id signed by me.
+ my $message = $template->fill_in(HASH => { key => $key_id,
+ uids => \@uids,
+ owner => $CONFIG{'owner'}})
+ or die "Error filling template in: $Text::Template::ERROR";
-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 subkeys.pgp.net --send-key $key_id
-
-If you have any questions, don't hesitate to ask.
-
-Regards,
-$CONFIG{'owner'}
-};
my $message_entity = MIME::Entity->build(
Type => "text/plain",
Charset => "utf-8",
Type => "application/pgp-keys",
Disposition => 'attachment',
Encoding => "7bit",
- Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
+ Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
Data => $key->{'key'},
- Filename => "0x$key_id.".$key->{'serial'}.".asc");
+ Filename => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
};
if ($can_encrypt) {
my $gpg = GnuPG::Interface->new();
$gpg->call( $CONFIG{'gpg'} );
$gpg->options->hash_init( 'homedir' => $GNUPGHOME,
- 'extra_args' => '--always-trust',
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
'armor' => 1 );
$gpg->options->meta_interactive( 0 );
my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
$gpg->options->push_recipients( $key_id );
- $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
+ 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, $inputfd, $stdoutfd, $stderrfd, $statusfd);
waitpid $pid, 0;
if ($stdout eq '') {
- warn ("No data from gpg for list-key $key_id\n");
- next;
+ 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"');
+ 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->head->add("Subject", "Your signed PGP key 0x$key_id");
$message_entity->head->add("To", $address);
- $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
+ $message_entity->head->add("From", '"'.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);
- $message_entity->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.)") if (scalar @{$CONFIG{'mailer-send'}} > 0);
+ $message_entity->send(@{$CONFIG{'mailer-send'}});
$message_entity->stringify();
};
+######
+# clean up a UID so that it can be used on the FS.
+######
sub sanitize_uid($) {
my ($uid) = @_;
return $good_uid;
};
-my $USER;
+sub delete_signatures($$$$$$) {
+ my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
+
+ my $signed_by_me = 0;
+
+ my ($stdout, $stderr, $status) =
+ readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
+
+ while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
+ # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
+ my @sigline = grep { /^sig/ } (split /\n/, $stdout);
+ $stdout =~ s/\n/\\n/g;
+ notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
+ my $line = pop @sigline;
+ my $answer = "no";
+ if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
+ debug("[sigremoval] doing line $line.");
+ my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
+ if ($signer eq $longkeyid) {
+ debug("[sigremoval] selfsig ($signer).");
+ $answer = "no";
+ } elsif (grep { $signer eq $_ } @{$keyids}) {
+ debug("[sigremoval] signed by us ($signer).");
+ $answer = "no";
+ $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
+ } else {
+ debug("[sigremoval] not interested in that sig ($signer).");
+ $answer = "yes";
+ };
+ } else {
+ debug("[sigremoval] no sig line here, only got: ".$stdout);
+ };
+ ($stdout, $stderr, $status) =
+ readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
+ };
+
+ return $signed_by_me;
+};
+
+##
+# 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. The last check ensure we have those keyids
+# available in the caff's gnupghome directory.
+#
+# @return an array containing the local user keys\n
+# (undef) if no key has been specified
+#
+sub get_local_user_keys()
+{
+ my @local_user = ();
+ my @key_list;
+
+ # No user-defined key id has been specified by the user, no need for
+ # further checks
+ if (!$CONFIG{'local-user'}) {
+ return (undef);
+ }
+
+ # Parse the list of keys
+ if (ref($CONFIG{'local-user'})) {
+ @key_list = @{$CONFIG{'local-user'}};
+ }
+ else {
+ @key_list = split /\s*,\s*/, $CONFIG{'local-user'};
+ }
+
+ # Check every key defined by the user...
+ for my $user_key (@key_list) {
+
+ $user_key =~ s/^0x//i;
+ $user_key = uc($user_key);
+
+ unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) {
+ mywarn "Local-user $user_key is not a valid keyid.";
+ next;
+ }
+
+ 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
+ unless (defined $local_user[0]) {
+ myerror (1, "None of the local-user keys seem to be known as a keyid listed in ./caffrc.");
+ }
+
+ return @local_user;
+}
+
+
+###################
+# argument handling
+###################
my @KEYIDS;
+my $params;
+
+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'},
+ )) {
+ usage(\*STDERR, 1);
+};
+if ($params->{'help'}) {
+ usage(\*STDOUT, 0);
+};
+if ($params->{'version'}) {
+ version(\*STDOUT);
+ exit(0);
+};
+usage(\*STDERR, 1) unless scalar @ARGV >= 1;
-usage() unless scalar @ARGV >= 1;
-if ($ARGV[0] eq '-u') {
- usage() unless scalar @ARGV >= 3;
- shift @ARGV;
- $USER = shift @ARGV;
- unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
- print STDERR "-u $USER is not a keyid.\n";
- usage();
+$CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
+$CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
+$CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
+
+$CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
+$CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
+
+# 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';
+}
+
+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
+ $keyid =~ s/^0x//i;
+ $keyid =~ s/ //g; # gpg --fingerprint includes spaces
+ if ($keyid =~ /^[A-F0-9]{32}$/i) {
+ info("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
+ next;
};
- $USER = uc($USER);
-};
-for my $keyid (@ARGV) {
- unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
+ if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
print STDERR "$keyid is not a keyid.\n";
- usage();
+ usage(\*STDERR, 1);
};
push @KEYIDS, uc($keyid);
};
-
-
#################
# import own keys
#################
- my $gpg = GnuPG::Interface->new();
- $gpg->call( $CONFIG{'gpg'} );
- $gpg->options->hash_init(
- 'homedir' => $GNUPGHOME,
- 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
- $gpg->options->meta_interactive( 0 );
- my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
- $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
- my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'});
- my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
- waitpid $pid, 0;
- if ($stdout eq '') {
- warn ("No data from gpg for list-key\n");
- next;
- };
- print $stdout;
- foreach my $keyid (@{$CONFIG{'keyid'}}) {
- unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
- info("Importing $keyid");
- system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME";
- }
- }
+for my $keyid (@{$CONFIG{'keyid'}}) {
+ info("Importing key $keyid from your normal GnuPGHome.");
+ my $key = export_key(undef, $keyid);
+ if (!defined $key || $key eq '') {
+ warn ("Did not get key $keyid from your normal GnuPGHome\n");
+ next;
+ };
+ my $result = import_key($GNUPGHOME, $key);
+ unless ($result) {
+ warn ("Could not import $keyid into caff's gnupghome.\n");
+ next;
+ };
+}
+
+########################
+# import keys from files
+########################
+foreach my $keyfile (@{$CONFIG{'key-files'}}) {
+ my $gpg = GnuPG::Interface->new();
+ $gpg->call( $CONFIG{'gpg'} );
+ $gpg->options->hash_init('homedir' => $GNUPGHOME);
+ $gpg->options->meta_interactive( 0 );
+ my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
+ my $pid = $gpg->import_keys(handles => $handles, command_args => $keyfile);
+ my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
+ info ("Importing keys from $keyfile");
+ waitpid $pid, 0;
+ if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
+ warn $stderr;
+ }
+}
#############################
# receive keys from keyserver
#############################
my @keyids_ok;
-my @keyids_failed;
if ($CONFIG{'no-download'}) {
@keyids_ok = @KEYIDS;
} else {
+ info ("fetching keys, this will take a while...");
+
my $gpg = GnuPG::Interface->new();
$gpg->call( $CONFIG{'gpg'} );
$gpg->options->hash_init(
'homedir' => $GNUPGHOME,
- 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
$gpg->options->meta_interactive( 0 );
my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
-
- my @local_keyids = @KEYIDS;
- for my $keyid (@local_keyids) {
- info ("fetching $keyid...");
- my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
- my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
- waitpid $pid, 0;
+ my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
+ my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
+ waitpid $pid, 0;
# [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
# [GNUPG:] NODATA 1
# [GNUPG:] NODATA 1
# [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
- my $handled = 0;
- for my $line (split /\n/, $status) {
- if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
- push @keyids_ok, shift @KEYIDS;
- $handled = 1;
- last;
- } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
- push @keyids_failed, shift @KEYIDS;
- $handled = 1;
- last;
+ my %local_keyids = map { $_ => 1 } @KEYIDS;
+ my $had_v3_keys = 0;
+ for my $line (split /\n/, $status) {
+ if ($line =~ /^\[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 ($handled) {
- notice ("Huh, what's up with $keyid?");
- push @keyids_failed, shift @KEYIDS;
- };
+ unless ($speced_key) {
+ notice ("Imported unexpected key; got: $imported_key\n");
+ next;
+ };
+ debug ("Imported $imported_key for $speced_key");
+ delete $local_keyids{$speced_key};
+ unshift @keyids_ok, $imported_key;
+ } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
+ } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
+ my $imported_key = $1;
+ notice ("Imported key $1 is a version 3 key. Version 3 keys are obsolete, should not be used, and are not and will not be properly supported.");
+ $had_v3_keys = 1;
+ } else {
+ notice ("got unknown reply from gpg: $line");
+ }
};
- die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS;
- notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
+ 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;
+ }
};
+unless (@keyids_ok) {
+ notice ("No keys to sign found");
+ exit 0;
+}
+
###########
# sign keys
###########
-unless ($CONFIG{'no-sign'}) {
+if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
+ $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
+}
+
+unless ($CONFIG{'no-sign'})
+{
+ my @local_user = &get_local_user_keys();
+
info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
for my $keyid (@keyids_ok) {
- my @command;
- push @command, $CONFIG{'gpg-sign'};
- push @command, '--local-user', $USER if (defined $USER);
- push @command, "--homedir=$GNUPGHOME";
- push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
- push @command, '--edit', $keyid;
- push @command, 'sign';
- print join(' ', @command),"\n";
- system (@command);
+ 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, '--no-auto-check-trustdb';
+ push @command, '--trust-model=always';
+ push @command, '--edit', $keyid;
+ push @command, 'sign';
+ push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
+ print join(' ', @command),"\n";
+ system (@command);
+ };
};
};
#################
my $gpg = GnuPG::Interface->new();
$gpg->call( $CONFIG{'gpg'} );
- $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
+ $gpg->options->hash_init(
+ 'homedir' => $GNUPGHOME,
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
$gpg->options->meta_interactive( 0 );
my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
- $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
waitpid $pid, 0;
warn ("No data from gpg for list-key $keyid\n");
next;
};
- my $keyinfo = $stdout;
my @publine = grep { /^pub/ } (split /\n/, $stdout);
- my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
- my $can_encrypt = $flags =~ /E/;
+ if (scalar @publine == 0) {
+ warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
+ next;
+ };
+ my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
+ if (scalar @publine > 0) {
+ warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
+ next;
+ };
unless (defined $longkeyid) {
- warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
+ warn ("Didn't find public keyid in --list-key of key $keyid.\n");
next;
};
+ unless (defined $flags) {
+ warn ("Didn't find flags in --list-key of key $keyid.\n");
+ next;
+ };
+ my $can_encrypt = $flags =~ /E/;
# export the key
################
my $this_uid_text = '';
$uid_number++;
debug("Doing key $keyid, uid $uid_number");
+ my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
# import into temporary gpghome
###############################
- my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
- my $gpg = GnuPG::Interface->new();
- $gpg->call( $CONFIG{'gpg'} );
- $gpg->options->hash_init( 'homedir' => $tempdir );
- $gpg->options->meta_interactive( 0 );
- my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
- my $pid = $gpg->import_keys(handles => $handles);
- my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
- waitpid $pid, 0;
-
- if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
+ my $result = import_key($tempdir, $asciikey);
+ unless ($result) {
warn ("Could not import $keyid into temporary gnupg.\n");
next;
};
$gpg->call( $CONFIG{'gpg-delsig'} );
$gpg->options->hash_init(
'homedir' => $tempdir,
- 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
+ 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
$pid = $gpg->wrap_call(
commands => [ '--edit' ],
debug("Parsing stdout output.");
for my $line (split /\n/, $stdout) {
debug("Checking line $line");
- my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
+ my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
if ($type eq 'sub') {
$number_of_subkeys++;
};
if ($uid_number != $i) {
debug("mark for deletion.");
readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
- $delete_some = 1;
+ $delete_some++;
} else {
debug("keep it.");
$have_one = 1;
- $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';
+ $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
$is_uat = $type eq 'uat';
};
$i++;
};
debug("Parsing stdout output done.");
- if ($is_uat) {
- notice("Can't handle attribute userid of key $keyid.");
- next;
- };
unless ($have_one) {
debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
info("key $keyid done.");
last;
};
+
+ my $prune_some_sigs_on_uid;
+ my $prune_all_sigs_on_uid;
+ if ($is_uat) {
+ debug("handling attribute userid of key $keyid.");
+ if ($uid_number == 1) {
+ debug(" attribute userid is #1, unmarking #2 for deletion.");
+ readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
+ $delete_some--;
+ $prune_some_sigs_on_uid = 1;
+ $prune_all_sigs_on_uid = 2;
+ } else {
+ debug("attribute userid is not #1, unmarking #1 for deletion.");
+ readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
+ $delete_some--;
+ $prune_some_sigs_on_uid = 2;
+ $prune_all_sigs_on_uid = 1;
+ };
+ } else {
+ $prune_some_sigs_on_uid = 1;
+ };
+
if ($delete_some) {
- debug("need to delete a few uids.");
+ debug("need to delete $delete_some uids.");
readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
};
# delete signatures
###################
- my $signed_by_me = 0;
- readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
- ($stdout, $stderr, $status) =
- readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
-
- while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
- # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
- my @sigline = grep { /^sig/ } (split /\n/, $stdout);
- $stdout =~ s/\n/\\n/g;
- notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
- my $line = pop @sigline;
- my $answer = "no";
- if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
- debug("[sigremoval] doing line $line.");
- my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
- if ($signer eq $longkeyid) {
- debug("[sigremoval] selfsig ($signer).");
- $answer = "no";
- } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {
- debug("[sigremoval] signed by us ($signer).");
- $answer = "no";
- $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
- } else {
- debug("[sigremoval] not interested in that sig ($signer).");
- $answer = "yes";
- };
- } else {
- debug("[sigremoval] no sig line here, only got: ".$stdout);
- };
- ($stdout, $stderr, $status) =
- readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
+ readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
+ my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
+ readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
+ if (defined $prune_all_sigs_on_uid) {
+ readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
+ delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
+ readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
};
+
+
readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
waitpid $pid, 0;
- my $asciikey = export_key($tempdir, $longkeyid);
+ my $asciikey = export_key($tempdir, $keyid);
if ($asciikey eq '') {
- warn ("No data from gpg for export $longkeyid\n");
+ warn ("No data from gpg for export $keyid\n");
next;
};
if ($signed_by_me) {
if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
- my $write = ask("Signature on $this_uid_text is old. Export?", 0);
+ my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
next unless $write;
};
my $keydir = "$KEYSBASE/$DATE_STRING";
-d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
- open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");
+ open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
print KEY $asciikey;
close KEY;
- push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
+ push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
info("$longkeyid $uid_number $this_uid_text done.");
} else {
if (scalar @UIDS == 0) {
info("found no signed uids for $keyid");
} else {
- my @attached ;
+ next if ($CONFIG{'mail'} eq 'no'); # do not send mail
+
+ my @attached;
for my $uid (@UIDS) {
trace("UID: $uid->{'text'}\n");
- unless ($uid->{'text'} =~ /@/) {
+ if ($uid->{'is_uat'}) {
+ my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
+ push @attached, $uid if $attach;
+ } elsif ($uid->{'text'} !~ /@/) {
my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
push @attached, $uid if $attach;
};
notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
for my $uid (@UIDS) {
- if ($uid->{'text'} =~ /@/) {
+ if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
my $address = $uid->{'text'};
$address =~ s/.*<(.*)>.*/$1/;
- my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1);
- if ($send) {
+ if (ask("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
-
- my $keydir = "$KEYSBASE/$DATE_STRING";
- my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
- open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");
- print KEY $mail;
- close KEY;
+ if (defined $mail) {
+ my $keydir = "$KEYSBASE/$DATE_STRING";
+ my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
+ open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
+ print KEY $mail;
+ close KEY;
+ } 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.
-###############################################################3
-#### old fork gpg --edit
-=cut
- my ($stdin_read, $stdin_write);
- my ($stdout_read, $stdout_write);
- my ($stderr_read, $stderr_write);
- my ($status_read, $status_write);
- pipe $stdin_read, $stdin_write;
- pipe $stdout_read, $stdout_write;
- pipe $stderr_read, $stderr_write;
- pipe $status_read, $status_write;
-
- $pid = fork();
- unless ($pid) { # child
- close $stdin_write;
- close $stdout_read;
- close $stderr_read;
- close $status_read;
-
- my @call;
- push @call, $CONFIG{'gpg-delsig'};
- push @call, "--homedir=$tempdir";
- push @call, '--with-colons';
- push @call, '--fixed-list-mode';
- push @call, '--command-fd=0';
- push @call, "--status-fd=".fileno($status_write);
- push @call, "--no-tty";
- push @call, "--edit";
- push @call, $keyid;
-
- close STDIN;
- close STDOUT;
- close STDERR;
- open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n");
- open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n");
- open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n");
-
- fcntl $status_write, F_SETFD, 0;
-
- exec (@call);
- exit;
- };
- close $stdin_read;
- close $stdout_write;
- close $stderr_write;
- close $status_write;
-
- $inputfd = $stdin_write;
- $stdoutfd = $stdout_read;
- $stderrfd = $stderr_read;
- $statusfd = $status_read;
-=cut
+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}
projects / pgp-tools.git / blobdiff