X-Git-Url: https://git.sthu.org/?a=blobdiff_plain;f=caff%2Fcaff;h=362ff95ff17fdc63ed1b7a15af2b07f621db4c00;hb=b8faf2bc7b76f47e6cc494c81c0225ff1c4e8527;hp=ec6b6f409efc84d646b593e60d48be9059b7bd82;hpb=5123d7a225d40ab965e573809acb3c6b6a65f0dd;p=pgp-tools.git diff --git a/caff/caff b/caff/caff index ec6b6f4..362ff95 100755 --- a/caff/caff +++ b/caff/caff @@ -3,7 +3,8 @@ # caff -- CA - Fire and Forget # $Id$ # -# Copyright (c) 2004, 2005 Peter Palfrader +# Copyright (c) 2004, 2005, 2006 Peter Palfrader +# Copyright (c) 2005, 2006 Christoph Berg # # All rights reserved. # @@ -39,7 +40,7 @@ caff -- CA - Fire and Forget =over -=item B [-mMR] [-u I] I [I ..] +=item B [-eERS] [-m I] [-u I] I [I ..] =back @@ -49,23 +50,45 @@ 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. +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<-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> I + +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<-u> I +=item B<-S>, B<--no-sign> + +Do not sign the keys. + +=item B<-u> I, B<--local-user> I 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 + +Import keys from file. Can be supplied more than once. =back @@ -75,26 +98,31 @@ Select the key that is used for signing, in case you have more than one key. =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 [string] - -Base directory for the files caff stores. Default: B<$HOME/.caff/>. - =item B [string] Your name. B. @@ -109,14 +137,21 @@ 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. -=item B [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 [string] +=over + +=item B [string] + +Base directory for the files caff stores. Default: B<$HOME/.caff/>. -Keyserver to download keys from. Default: B. +=back + +=head2 GnuPG settings + +=over =item B [string] @@ -137,29 +172,141 @@ is set to. Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>. -=item B [keyid] +=item B [keyid, or list of keyids] + +Additional keyids to encrypt messages to. Default: none. -An additional keyid to encrypt messages to. Default: none. +=item B [string] + +Additional commands to pass to gpg after the "sign" command. +Default: none. + +=back + +=head2 Keyserver settings + +=over + +=item B [string] + +Keyserver to download keys from. Default: B. =item B [boolean] If true, then skip the step of fetching keys from the keyserver. Default: B<0>. +=item B [list of files] + +A list of files containing keys to be imported. + +=back + +=head2 Signing settings + +=over + =item B [boolean] If true, then skip the signing step. Default: B<0>. +=item B [boolean] + +If true, then pause before continuing to the signing step. +This is useful for offline signing. Default: B<0>. + +=item B [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 [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 [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. + +In any case, the messages are also written to $CONFIG{'caffhome'}/keys/ + +=item B [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|/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 [string] + +Add a Reply-To: header to messages sent. Default: none. + +=item B [string] + +Address to send blind carbon copies to when sending mail. +Default: none. + +=item B [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 -Peter Palfrader +=over + +=item Peter Palfrader + +=item Christoph Berg + +=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; @@ -167,10 +314,12 @@ use IO::Handle; 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::Std; +use Getopt::Long; use GnuPG::Interface; my %CONFIG; @@ -178,32 +327,23 @@ my $REVISION = '$Rev$'; 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"; @@ -225,6 +365,152 @@ sub trace2($) { #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 = < +# +# 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 ; + $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 ; + } + 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(), @@ -334,15 +620,37 @@ sub readwrite_gpg($$$$$%) { 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 = ; + 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; @@ -362,7 +670,7 @@ my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET 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'; @@ -375,20 +683,37 @@ 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 usage() { - print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n"; - print STDERR "Usage: $PROGRAM_NAME [-mMR] [-u ] [ ...]\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 ] [-u ] [ ...]\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 ]); @@ -398,28 +723,52 @@ sub export_key($$) { 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. - -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 + my $message = $template->fill_in(HASH => { key => $key_id, + uids => \@uids, + owner => $CONFIG{'owner'}}) + or die "Error filling template in: $Text::Template::ERROR"; -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", @@ -432,9 +781,9 @@ $CONFIG{'owner'} 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) { @@ -443,26 +792,42 @@ $CONFIG{'owner'} 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 \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"); @@ -477,12 +842,18 @@ $CONFIG{'owner'} $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) = @_; @@ -492,131 +863,305 @@ sub sanitize_uid($) { return $good_uid; }; -my $USER; -my @KEYIDS; -my %opt; +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); + }; -getopts('mMRu:', \%opt); + return $signed_by_me; +}; -usage() unless scalar @ARGV >= 1; -if ($opt{u}) { - $USER = $opt{u}; - $USER =~ s/^0x//i; - unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) { - print STDERR "-u $USER is not a keyid.\n"; - usage(); - }; - $USER = uc($USER); +## +# 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); }; -for my $keyid (@ARGV) { +usage(\*STDERR, 1) unless scalar @ARGV >= 1; + +$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; - unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8}|[A-Za-z0-9]{32})?$/) { + $keyid =~ s/ //g; # gpg --fingerprint includes spaces + if ($keyid =~ /^[A-F0-9]{32}$/i) { + info("Ignoring v3 fingerprint $keyid. v3 keys are obsolete."); + next; + }; + 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; - }; - 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'} 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; + 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, $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) /) { + } 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); + }; }; }; @@ -629,10 +1174,11 @@ for my $keyid (@keyids_ok) { ################# 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; @@ -674,20 +1220,12 @@ for my $keyid (@keyids_ok) { 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; }; @@ -698,7 +1236,7 @@ for my $keyid (@keyids_ok) { $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' ], @@ -727,27 +1265,45 @@ for my $keyid (@keyids_ok) { 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); }; @@ -764,38 +1320,16 @@ for my $keyid (@keyids_ok) { # 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; @@ -807,18 +1341,18 @@ for my $keyid (@keyids_ok) { 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 { @@ -829,12 +1363,15 @@ for my $keyid (@keyids_ok) { if (scalar @UIDS == 0) { info("found no signed uids for $keyid"); } else { - next if $opt{M}; # do not send mail + 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; }; @@ -842,17 +1379,20 @@ for my $keyid (@keyids_ok) { 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'?", $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"; + }; }; }; }; @@ -860,58 +1400,28 @@ for my $keyid (@keyids_ok) { }; +########################### +# 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}