# $Id$
#
# Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
+# Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
#
# All rights reserved.
#
=over
-=item B<caff> [-mMR] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
+=item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
=back
=over
-=item B<-m> B<-M>
+=item B<-e>, B<--export-old>
-Send/do not send mail after signing. Default is to ask the user for each uid.
+Export old signatures. Default is to ask the user for each old signature.
-=item B<-R>
+=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>
+
+Send mail after signing. Default is to ask the user for each uid.
+
+=item B<-M>, B<--no-mail>
+
+Do not send mail after signing. Default is to ask the user for each uid.
+
+=item B<-R>, B<--no-download>
Do not retrieve the key to be signed from a keyserver.
-=item B<-u> I<yourkeyid>
+=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.
$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]
+=head2 General settings
-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<caffhome> [string]
-=item B<keyserver> [string]
+Base directory for the files caff stores. Default: B<$HOME/.caff/>.
-Keyserver to download keys from. Default: B<subkeys.pgp.net>.
+=head2 GnuPG settings
=item B<gpg> [string]
An additional keyid to encrypt messages to. Default: none.
+=item B<gpg-sign-args> [string]
+
+Additional arguments to pass to gpg. Default: none.
+
+=head2 Keyserver settings
+
+=item B<keyserver> [string]
+
+Keyserver to download keys from. Default: B<subkeys.pgp.net>.
+
=item B<no-download> [boolean]
If true, then skip the step of fetching keys from the keyserver.
Default: B<0>.
+=head2 Signing settings
+
=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).
+
+=head2 Mail settings
+
+=item B<mail> [boolean]
+
+Do not prompt for sending mail, just do it. Default: B<0>.
+
+=item B<no-mail> [boolean]
+
+Do not prompt for sending mail. The messages are still written to
+$CONFIG{caffhome}/keys/. Default: B<0>.
+
=item B<mail-template> [string]
-Email template which is used as the body text for the email sent out.
+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:
=back
+=item B<bcc> [string]
+
+Address to send blind carbon copies to when sending mail.
+Default: none.
+
=back
-=head1 AUTHOR
+=head1 AUTHORS
+
+=over
+
+=item Peter Palfrader <peter@palfrader.org>
+
+=item Christoph Berg <cb@df7cb.de>
-Peter Palfrader <peter@palfrader.org>
+=back
=head1 WEBSITE
use MIME::Entity;
use Fcntl;
use IO::Select;
-use Getopt::Std;
+use Getopt::Long;
use GnuPG::Interface;
my %CONFIG;
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");
+ $keyid =~ /^[A-F0-9]{16}$/i 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'};
$OUT .= "\t".$uid."\n";
};} of your key {$key} signed by me.
-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
+Note that I did not upload your key to any keyservers.
+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`.
+
+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}
If you have any questions, don't hesitate to ask.
return ($stdout, $stderr, $status);
};
-sub ask($$) {
- my ($question, $default) = @_;
+sub ask($$;$$) {
+ my ($question, $default, $forceyes, $forceno) = @_;
my $answer;
while (1) {
print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
+ 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>;
chomp $answer;
last if ((defined $answer) && (length $answer <= 1));
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 - (c) 2004, 2005 Peter Palfrader et al.";
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 [-mMR] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
- exit 1;
+sub version($) {
+ my ($fd) = @_;
+ print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
+};
+
+sub usage($$) {
+ my ($fd, $exitcode) = @_;
+ version($fd);
+ print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-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) = @_;
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();
$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("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
$message_entity->head->add("User-Agent", $USER_AGENT);
$message_entity->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;
};
+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;
+};
+
+
+
my $USER;
my @KEYIDS;
-my %opt;
+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' => \$params->{'mail'},
+ '--mail' => \$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'},
+ )) {
+ usage(\*STDERR, 1);
+};
+if ($params->{'help'}) {
+ usage(\*STDOUT, 0);
+};
+if ($params->{'version'}) {
+ version(\*STDOUT);
+ exit(0);
+};
+usage(\*STDERR, 1) unless scalar @ARGV >= 1;
+
-getopts('mMRu:', \%opt);
-usage() unless scalar @ARGV >= 1;
-if ($opt{u}) {
- $USER = $opt{u};
+if ($params->{'local-user'}) {
+ $USER = $params->{'local-user'};
$USER =~ s/^0x//i;
- unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
+ unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
print STDERR "-u $USER is not a keyid.\n";
- usage();
+ usage(\*STDERR, 1);
};
$USER = uc($USER);
};
+
for my $keyid (@ARGV) {
$keyid =~ s/^0x//i;
- unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8}|[A-Za-z0-9]{32})?$/) {
+ unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
+ if ($keyid =~ /^[A-F0-9]{32}$/) {
+ info("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
+ next;
+ };
print STDERR "$keyid is not a keyid.\n";
- usage();
+ usage(\*STDERR, 1);
};
push @KEYIDS, uc($keyid);
};
+$CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
+$CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
+$CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
+$CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
#################
# import own keys
#################
+for my $keyid (@{$CONFIG{'keyid'}}) {
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 --with-colons --fixed-list-mode --fast-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 => $CONFIG{'keyid'});
+ my $pid = $gpg->list_public_keys(handles => $handles, command_args => $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;
+ warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
};
- foreach my $keyid (@{$CONFIG{'keyid'}}) {
- unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
- info("Importing $keyid");
- system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME";
- }
+ unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
+ info("Key $keyid not found in caff's home. Getting it 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;
+ };
}
+}
#############################
# receive keys from keyserver
#############################
my @keyids_ok;
-my @keyids_failed;
-if ($CONFIG{'no-download'} or $opt{R}) {
+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 \d+ ([0-9A-F]{40})/) {
- my $imported_key = $1;
- if ($keyid ne $imported_key &&
- $keyid ne substr($imported_key, -16) &&
- $keyid ne substr($imported_key, -8)) {
- warn("Imported unexpected key. expected: $keyid; got: $imported_key.\n");
- next;
- };
- push @keyids_ok, $keyid;
- shift @KEYIDS;
- $handled = 1;
- last;
- } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
- push @keyids_failed, $keyid;
- shift @KEYIDS;
- $handled = 1;
- last;
+ my %local_keyids = map { $_ => 1 } @KEYIDS;
+ 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, $keyid;
- 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) /) {
+ } 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).".");
+ exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
+ }
};
+unless (@keyids_ok) {
+ notice ("No keys to sign found");
+ exit 0;
+}
+
###########
# sign keys
###########
+if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
+ $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
+}
+
unless ($CONFIG{'no-sign'}) {
info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
for my $keyid (@keyids_ok) {
push @command, '--local-user', $USER if (defined $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;
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' ],
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 (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 $_ } @{$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;
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";
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 {
- next if $opt{M}; # do not send mail
+ next if $CONFIG{'no-mail'}; # 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/;
- if ($opt{m} or ask("Send mail to '$address' for $uid->{'text'}?", 1)) {
+ if (ask("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
my $keydir = "$KEYSBASE/$DATE_STRING";
};
};
-
-
-
-
-###############################################################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
projects / pgp-tools.git / blobdiff