3 # caff -- CA - Fire and Forget
6 # Copyright (c) 2004, 2005, 2006 Peter Palfrader <peter@palfrader.org>
7 # Copyright (c) 2005, 2006 Christoph Berg <cb@df7cb.de>
11 # Redistribution and use in source and binary forms, with or without
12 # modification, are permitted provided that the following conditions
14 # 1. Redistributions of source code must retain the above copyright
15 # notice, this list of conditions and the following disclaimer.
16 # 2. Redistributions in binary form must reproduce the above copyright
17 # notice, this list of conditions and the following disclaimer in the
18 # documentation and/or other materials provided with the distribution.
19 # 3. The name of the author may not be used to endorse or promote products
20 # derived from this software without specific prior written permission.
22 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
23 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
24 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
25 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
27 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
31 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 caff -- CA - Fire and Forget
43 =item B<caff> [-eERS] [-m I<yes|ask-yes|ask-no|no>] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
49 CA Fire and Forget is a script that helps you in keysigning. It takes a list
50 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
51 that you can sign it. It then mails each key to all its email addresses - only
52 including the one UID that we send to in each mail, pruned from all but self
53 sigs and sigs done by you. The mailed key is encrypted with itself as a means
54 to verify that key belongs to the recipient.
60 =item B<-e>, B<--export-old>
62 Export old signatures. Default is to ask the user for each old signature.
64 =item B<-E>, B<--no-export-old>
66 Do not export old signatures. Default is to ask the user for each old
69 =item B<-m>, B<--mail> I<yes|ask-yes|ask-no|no>
71 Whether to send mail after signing. Default is to ask, for each uid,
72 with a default value of yes.
74 =item B<-R>, B<--no-download>
76 Do not retrieve the key to be signed from a keyserver.
78 =item B<-S>, B<--no-sign>
82 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
84 Select the key that is used for signing, in case you have more than one key.
85 To sign with multiple keys at once, separate multiple keyids by comma. This
86 option requires the key(s) to be defined through the keyid variable in the
89 =item B<--key-file> I<file>
91 Import keys from file. Can be supplied more than once.
93 =item B<--keys-from-gnupg> I<file>
95 Try to import keys from your standard GnuPG keyrings.
103 =item $HOME/.caffrc - configuration file
105 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
107 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
109 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
111 useful options include use-agent, keyserver-options, default-cert-level, etc.
115 =head1 CONFIGURATION FILE OPTIONS
117 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
118 The file is generated when it does not exist.
122 $CONFIG{'owner'} = q{Peter Palfrader};
123 $CONFIG{'email'} = q{peter@palfrader.org};
124 $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
126 =head2 Required basic settings
130 =item B<owner> [string]
132 Your name. B<REQUIRED>.
134 =item B<email> [string]
136 Your email address, used in From: lines. B<REQUIRED>.
138 =item B<keyid> [list of keyids]
140 A list of your keys. This is used to determine which signatures to keep
141 in the pruning step. If you select a key using B<-u> it has to be in
142 this list. B<REQUIRED>.
146 =head2 General settings
150 =item B<caffhome> [string]
152 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
156 =head2 GnuPG settings
160 =item B<gpg> [string]
162 Path to the GnuPG binary. Default: B<gpg>.
164 =item B<gpg-sign> [string]
166 Path to the GnuPG binary which is used to sign keys. Default: what
169 =item B<gpg-delsig> [string]
171 Path to the GnuPG binary which is used to split off signatures. This was
172 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
175 =item B<secret-keyring> [string]
177 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
179 =item B<also-encrypt-to> [keyid, or list of keyids]
181 Additional keyids to encrypt messages to. Default: none.
183 =item B<gpg-sign-args> [string]
185 Additional commands to pass to gpg after the "sign" command.
190 =head2 Keyserver settings
194 =item B<keyserver> [string]
196 Keyserver to download keys from. Default: B<pool.sks-keyservers.net>.
198 =item B<no-download> [boolean]
200 If true, then skip the step of fetching keys from the keyserver.
203 =item B<key-files> [list of files]
205 A list of files containing keys to be imported.
209 =head2 Signing settings
213 =item B<no-sign> [boolean]
215 If true, then skip the signing step. Default: B<0>.
217 =item B<ask-sign> [boolean]
219 If true, then pause before continuing to the signing step.
220 This is useful for offline signing. Default: B<0>.
222 =item B<export-sig-age> [seconds]
224 Don't export UIDs by default, on which your latest signature is older
225 than this age. Default: B<24*60*60> (i.e. one day).
227 =item B<local-user> [keyid, or list of keyids]
229 Select the key that is used for signing, in case you have more than one key.
230 With multiple keyids, sign with each key in turn.
238 =item B<mail> [boolean]
240 Whether to send mails. This is a quad-option, with which you can set the
241 behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
242 each uid, with according defaults for the question. Default: B<ask-yes>.
244 In any case, the messages are also written to $CONFIG{'caffhome'}/keys/
246 =item B<mail-template> [string]
248 Email template which is used as the body text for the email sent out
249 instead of the default text if specified. The following perl variables
250 can be used in the template:
254 =item B<{owner}> [string]
256 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
258 =item B<{key}> [string]
260 The keyid of the key you signed.
262 =item B<{@uids}> [array]
264 The UIDs for which signatures are included in the mail.
268 =item B<reply-to> [string]
270 Add a Reply-To: header to messages sent. Default: none.
272 =item B<bcc> [string]
274 Address to send blind carbon copies to when sending mail.
277 =item B<mailer-send> [array]
279 Parameters to pass to Mail::Mailer.
280 This could for example be
282 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
284 to use the perl SMTP client or
286 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
288 to pass arguments to the sendmail program.
289 For more information run C<< perldoc Mail::Mailer >>.
290 Setting this option is strongly discouraged. Fix your local MTA
300 =item Peter Palfrader <peter@palfrader.org>
302 =item Christoph Berg <cb@df7cb.de>
308 http://pgp-tools.alioth.debian.org/
312 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/
320 use File
::Temp
qw{tempdir
};
327 use GnuPG
::Interface
;
330 my $REVISION = '$Rev$';
331 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
332 $REVISION_NUMER = 'unknown' unless defined $REVISION_NUMER;
333 my $VERSION = "0.0.0.$REVISION_NUMER";
340 # Display an error message on STDERR and then exit.
342 # @param $exitcode exit code status to use to end the program
343 # @param $line error message to display on STDERR
346 my ($exitcode, $line) = @_;
347 print "[ERROR] $line\n";
353 print "[WARN] $line\n";
357 print "[NOTICE] $line\n";
361 print "[INFO] $line\n";
365 #print "[DEBUG] $line\n";
369 #print "[trace] $line\n";
373 #print "[trace2] $line\n";
377 sub generate_config
() {
378 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
379 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
382 # BSD does not have hostname -f, so we try without -f first
383 my $hostname = `hostname`;
384 $hostname = `hostname -f` unless $hostname =~ /\./;
386 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
388 if (defined $gecos) {
391 my $gpg = GnuPG
::Interface
->new();
393 $gpg->options->hash_init(
394 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
395 $gpg->options->meta_interactive( 0 );
396 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
397 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
398 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
402 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
405 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
406 unless (scalar @keys) {
407 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
408 @keys = qw{0123456789abcdef
89abcdef76543210
};
411 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
412 unless (defined $email) {
413 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
414 $email = $ENV{'LOGNAME'}.'@'.$hostname;
418 $gecos = 'Unknown Caff User';
419 $email = $ENV{'LOGNAME'}.'@'.$hostname;
420 @keys = qw{0123456789abcdef
89abcdef76543210
};
421 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
424 my $template = <<EOT;
425 # .caffrc -- vim:ft=perl:
426 # This file is in perl(1) format - see caff(1) for details.
428 $Cgecos\$CONFIG{'owner'} = '$gecos';
429 $Cemail\$CONFIG{'email'} = '$email';
430 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
432 # You can get your long keyid from
433 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
435 # If you have a v4 key, it will simply be the last 16 digits of
439 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
440 # or, if you have more than one key:
441 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
442 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
444 # Select this/these keys to sign with
445 #\$CONFIG{'local-user'} = [ qw{@keys} ];
447 # Additionally encrypt messages for these keyids
448 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
450 # Mail template to use for the encrypted part
451 #\$CONFIG{'mail-template'} = << 'EOM';
454 $template .= "#$_" foreach <DATA
>;
455 $template .= "#EOM\n";
459 sub check_executable
($$) {
460 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
461 # so we want to check manually.)
462 my ($purpose, $fn) = @_;
463 # Only check provided fnames with a slash in them.
464 return unless defined $fn;
466 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
468 for my $p (split(':', $ENV{PATH
})) {
469 return if -x
"$p/$fn";
471 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
476 my $config = $ENV{'HOME'} . '/.caffrc';
477 unless (-f
$config) {
478 print "No configfile $config present, I will use this template:\n";
479 my $template = generate_config
();
480 print "$template\nPlease edit $config and run caff again.\n";
481 open F
, ">$config" or die "$config: $!";
486 unless (scalar eval `cat $config`) {
487 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
490 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
491 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
492 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
493 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
494 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
495 for my $keyid (@
{$CONFIG{'keyid'}}) {
496 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
498 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
499 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
500 $CONFIG{'keyserver'} = 'pool.sks-keyservers.net' unless defined $CONFIG{'keyserver'};
501 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
502 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
503 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
504 check_executable
("gpg", $CONFIG{'gpg'});
505 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
506 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
507 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
508 unless defined $CONFIG{'secret-keyring'};
509 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
510 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
511 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
512 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
513 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
514 unless (defined $CONFIG{'mail-template'}) {
515 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
517 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
518 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
524 stdin
=> IO
::Handle
->new(),
525 stdout
=> IO
::Handle
->new(),
526 stderr
=> IO
::Handle
->new(),
527 status
=> IO
::Handle
->new() );
528 my $handles = GnuPG
::Handles
->new( %fds );
529 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
532 sub readwrite_gpg
($$$$$%) {
533 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
535 trace
("Entering readwrite_gpg.");
537 my ($first_line, undef) = split /\n/, $in;
538 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
540 local $INPUT_RECORD_SEPARATOR = undef;
541 my $sout = IO
::Select
->new();
542 my $sin = IO
::Select
->new();
545 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
547 $inputfd->blocking(0);
548 $stdoutfd->blocking(0);
549 $statusfd->blocking(0) if defined $statusfd;
550 $stderrfd->blocking(0);
551 $sout->add($stdoutfd);
552 $sout->add($stderrfd);
553 $sout->add($statusfd) if defined $statusfd;
556 my ($stdout, $stderr, $status) = ("", "", "");
557 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
558 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
560 my $readwrote_stuff_this_time = 0;
561 my $do_not_wait_on_select = 0;
562 my ($readyr, $readyw, $written);
563 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
564 if (defined $exitwhenstatusmatches) {
565 if ($status =~ /$exitwhenstatusmatches/m) {
566 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
567 if ($readwrote_stuff_this_time) {
568 trace
("read/write some more\n");
569 $do_not_wait_on_select = 1;
571 trace
("that's it in our while loop.\n");
577 $readwrote_stuff_this_time = 0;
578 trace
("select waiting for ".($sout->count())." fds.");
579 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
580 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
581 for my $wfd (@
$readyw) {
582 $readwrote_stuff_this_time = 1;
583 if (length($in) != $offset) {
584 trace
("writing to $wfd.");
585 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
588 if ($offset == length($in)) {
589 trace
("writing to $wfd done.");
590 unless ($options{'nocloseinput'}) {
592 trace
("$wfd closed.");
599 next unless (defined(@
$readyr)); # Wait some more.
601 for my $rfd (@
$readyr) {
602 $readwrote_stuff_this_time = 1;
604 trace
("reading from $rfd done.");
609 trace
("reading from $rfd.");
610 if ($rfd == $stdoutfd) {
612 trace2
("stdout is now $stdout\n================");
615 if (defined $statusfd && $rfd == $statusfd) {
617 trace2
("status is now $status\n================");
620 if ($rfd == $stderrfd) {
622 trace2
("stderr is now $stderr\n================");
627 trace
("readwrite_gpg done.");
628 return ($stdout, $stderr, $status);
632 my ($question, $default, $forceyes, $forceno) = @_;
634 my $yn = $default ?
'[Y/n]' : '[y/N]';
636 print $question,' ',$yn, ' ';
637 if ($forceyes && $forceno) {
638 print "$default (from config/command line)\n";
642 print "YES (from config/command line)\n";
646 print "NO (from config/command line)\n";
651 if (!defined $answer) {
652 $OUTPUT_AUTOFLUSH = 1;
654 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
655 "so you can't really use it with xargs. A patch against caff to read from\n".
656 "the terminal would be appreciated.\n".
657 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
660 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
661 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
664 my $result = $default;
665 $result = 1 if $answer =~ /y/i;
666 $result = 0 if $answer =~ /n/i;
674 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
675 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
676 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
677 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
678 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
681 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
683 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
684 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
686 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
687 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
690 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
691 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
696 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
700 my ($fd, $exitcode) = @_;
702 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
703 print $fd "Consult the manual page for more information.\n";
708 # export key $keyid from $gnupghome
711 my ($gnupghome, $keyid) = @_;
713 my $gpg = GnuPG
::Interface
->new();
714 $gpg->call( $CONFIG{'gpg'} );
715 if (defined $gnupghome) {
716 $gpg->options->hash_init(
717 'homedir' => $gnupghome,
718 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
721 $gpg->options->hash_init(
722 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
725 $gpg->options->meta_interactive( 0 );
726 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
727 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
728 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
735 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
738 my ($gnupghome, $asciikey) = @_;
740 my $gpg = GnuPG
::Interface
->new();
741 $gpg->call( $CONFIG{'gpg'} );
742 $gpg->options->hash_init(
743 'homedir' => $gnupghome,
744 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
745 $gpg->options->meta_interactive( 0 );
746 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
747 my $pid = $gpg->import_keys(handles
=> $handles);
748 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
751 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
759 # Send an email to $address. If $can_encrypt is true then the mail
760 # will be PGP/MIME encrypted to $longkeyid.
762 # $longkeyid, $uid, and @attached will be used in the email and the template.
764 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
765 sub send_mail
($$$@
) {
766 my ($address, $can_encrypt, $key_id, @keys) = @_;
768 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
769 or die "Error creating template: $Text::Template::ERROR";
772 for my $key (@keys) {
773 push @uids, $key->{'text'};
775 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
777 owner
=> $CONFIG{'owner'}})
778 or die "Error filling template in: $Text::Template::ERROR";
780 my $message_entity = MIME
::Entity
->build(
781 Type
=> "text/plain",
783 Disposition
=> 'inline',
787 for my $key (@keys) {
788 $message_entity->attach(
789 Type
=> "application/pgp-keys",
790 Disposition
=> 'attachment',
792 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
793 Data
=> $key->{'key'},
794 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
798 my $message = $message_entity->stringify();
800 my $gpg = GnuPG
::Interface
->new();
801 $gpg->call( $CONFIG{'gpg'} );
802 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
803 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
805 $gpg->options->meta_interactive( 0 );
806 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
807 $gpg->options->push_recipients( $key_id );
808 if (defined $CONFIG{'also-encrypt-to'}) {
809 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
811 my $pid = $gpg->encrypt(handles
=> $handles);
812 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
815 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
816 (defined $CONFIG{'also-encrypt-to'})) {
819 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
820 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
821 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
822 "or try the following if you are slightly more daring:\n".
823 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
827 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
832 $message_entity = MIME
::Entity
->build(
833 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
836 $message_entity->attach(
837 Type
=> "application/pgp-encrypted",
838 Filename
=> "signedkey.msg",
839 Disposition
=> 'attachment',
841 Data
=> "Version: 1\n");
843 $message_entity->attach(
844 Type
=> "application/octet-stream",
845 Filename
=> 'msg.asc',
846 Disposition
=> 'inline',
851 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
852 $message_entity->head->add("To", $address);
853 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
854 $message_entity->head->add("Sender", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
855 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
856 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
857 $message_entity->head->add("User-Agent", $USER_AGENT);
858 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);
859 $message_entity->send(@
{$CONFIG{'mailer-send'}});
860 $message_entity->stringify();
864 # clean up a UID so that it can be used on the FS.
866 sub sanitize_uid
($) {
870 $good_uid =~ tr
#/:\\#_#;
871 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
875 sub delete_signatures
($$$$$$) {
876 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
878 my $signed_by_me = 0;
880 my ($stdout, $stderr, $status) =
881 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
883 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
884 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
885 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
886 $stdout =~ s/\n/\\n/g;
887 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
888 my $line = pop @sigline;
890 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
891 debug
("[sigremoval] doing line $line.");
892 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
893 if ($signer eq $longkeyid) {
894 debug
("[sigremoval] selfsig ($signer).");
896 } elsif (grep { $signer eq $_ } @
{$keyids}) {
897 debug
("[sigremoval] signed by us ($signer).");
899 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
901 debug
("[sigremoval] not interested in that sig ($signer).");
905 debug
("[sigremoval] no sig line here, only got: ".$stdout);
907 ($stdout, $stderr, $status) =
908 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
911 return $signed_by_me;
915 # Check the local user keys.
917 # This function checks if the keyids defined through the --local-user
918 # command line option or set in ~/.caffrc are valid and known to be one of the
919 # keyids listed in ~/.caffrc.
921 # @return an array containing the local user keys\n
922 # (undef) if no valid key has been found
924 sub get_local_user_keys
() {
928 # No user-defined key id has been specified by the user, no need for
930 if (!$CONFIG{'local-user'}) {
934 # Parse the list of keys
935 if (ref($CONFIG{'local-user'})) {
936 @key_list = @
{$CONFIG{'local-user'}};
939 @key_list = split /\s*,\s*/, $CONFIG{'local-user'};
942 # Check every key defined by the user...
943 for my $user_key (@key_list) {
945 $user_key =~ s/^0x//i;
946 $user_key = uc($user_key);
948 unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) {
949 mywarn
"Local-user $user_key is not a valid keyid.";
953 unless (grep (/$user_key$/, @
{$CONFIG{'keyid'}})) {
954 mywarn
"Local-user $user_key is not defined as one of your keyid in ~/.caffrc (it will not be used).";
958 push (@local_user, $user_key);
961 # If no local-user key are valid, there is no need to go further
962 unless (defined $local_user[0]) {
963 myerror
(1, "None of the local-user keys seem to be known as a keyid listed in ~/.caffrc.");
970 # Import a key from the user gnupghome into a specified gnupghome.
972 # @param asciikey ascii format of the gpg key to import
973 # @param dst_gnupghome gnupghome directory where to import the key
975 # @return 0 if successful\n
976 # 1 if the key could not be exported.\n
977 # 2 if the key could not be imported.
979 sub import_key_from_user_gnupghome
($$) {
981 my ($asciikey, $dst_gpghome) = @_;
983 trace
("Exporting key $asciikey from your normal GnuPGHOME.");
984 my $key = export_key
(undef, $asciikey);
985 if (defined $key && $key ne '') {
986 trace
("Importing key $asciikey into $GNUPGHOME.");
987 if (import_key
($GNUPGHOME, $key)) {
990 warn("Could not import $asciikey into caff's gnupghome.");
1001 # Import a key file into a specified gnupghome.
1003 # @param keyfile file containing the keys to import
1004 # @param dst_gnupghome gnupghome directory where to import the key
1006 # @return 0 if successful\n
1007 # 1 if an error occured.
1009 sub import_key_files
($$) {
1011 my ($keyfile, $dst_gpghome) = @_;
1013 my $gpg = GnuPG
::Interface
->new();
1014 $gpg->call( $CONFIG{'gpg'} );
1015 $gpg->options->hash_init(
1016 'homedir' => $dst_gpghome,
1017 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
1018 $gpg->options->meta_interactive( 0 );
1019 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1020 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
1021 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1022 info
("Importing keys from file $keyfile");
1025 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1036 # Import keys to be signed into caff gnupghome directory.
1038 # This function imports the keys the user wants to sign into the caff gnupghome
1039 # directory. We looks for the keys in the the user gnupghome directory first,
1040 # and in the key files specified by the user if not all of the keys have been
1043 sub import_keys_to_sign
() {
1044 # Check if we can find the gpg key from our normal gnupghome, and then
1045 # try to import it into our working gnupghome directory
1046 if ($CONFIG{'keys-from-gnupg'}) {
1047 foreach my $keyid (@KEYIDS) {
1048 if (!import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1049 info
("Key $keyid imported from your normal GnuPGHOME.");
1054 # Import user specified key files
1055 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
1056 import_key_files
($keyfile, $GNUPGHOME);
1065 Getopt
::Long
::config
('bundling');
1067 '-h' => \
$params->{'help'},
1068 '--help' => \
$params->{'help'},
1069 '--version' => \
$params->{'version'},
1070 '-V' => \
$params->{'version'},
1071 '-u=s' => \
$params->{'local-user'},
1072 '--local-user=s' => \
$params->{'local-user'},
1073 '-e' => \
$params->{'export-old'},
1074 '--export-old' => \
$params->{'export-old'},
1075 '-E' => \
$params->{'no-export-old'},
1076 '--no-export-old' => \
$params->{'no-export-old'},
1077 '-m:s' => \
$params->{'mail'},
1078 '--mail:s' => \
$params->{'mail'},
1079 '-M' => \
$params->{'no-mail'},
1080 '--no-mail' => \
$params->{'no-mail'},
1081 '-R' => \
$params->{'no-download'},
1082 '--no-download' => \
$params->{'no-download'},
1083 '-S' => \
$params->{'no-sign'},
1084 '--no-sign' => \
$params->{'no-sign'},
1085 '--key-file=s@' => \
$params->{'key-files'},
1086 '--keys-from-gnupg' => \
$params->{'keys-from-gnupg'},
1090 if ($params->{'help'}) {
1093 if ($params->{'version'}) {
1097 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
1099 for my $hashkey (qw{local-user
no-download
no-sign
no-mail mail
keys-from
-gnupg
}) {
1100 $CONFIG{$hashkey} = $params->{$hashkey} if defined $params->{$hashkey};
1102 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
1103 if ( defined $CONFIG{'no-mail'} ||
1104 ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) {
1105 $CONFIG{'mail'} = 'no';
1107 } elsif ( !defined $CONFIG{'mail'} ) {
1108 $CONFIG{'mail'} = 'ask-yes';
1111 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
1113 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
1115 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
1116 if ($keyid =~ /^[A-F0-9]{32}$/i) {
1117 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
1120 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1121 print STDERR
"$keyid is not a keyid.\n";
1124 push @KEYIDS, uc($keyid);
1130 for my $keyid (@
{$CONFIG{'keyid'}}) {
1131 info
("Importing key $keyid from your normal GnuPGHome.");
1132 if (import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1133 mywarn
("Key $keyid not found.");
1137 &import_keys_to_sign
();
1139 #############################
1140 # receive keys from keyserver
1141 #############################
1143 if ($CONFIG{'no-download'}) {
1144 @keyids_ok = @KEYIDS;
1146 info
("fetching keys, this will take a while...");
1148 my $gpg = GnuPG
::Interface
->new();
1149 $gpg->call( $CONFIG{'gpg'} );
1150 $gpg->options->hash_init(
1151 'homedir' => $GNUPGHOME,
1152 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1153 $gpg->options->meta_interactive( 0 );
1154 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1155 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1156 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1159 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1162 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1163 my %local_keyids = map { $_ => 1 } @KEYIDS;
1164 my $had_v3_keys = 0;
1165 for my $line (split /\n/, $status) {
1166 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1167 my $imported_key = $1;
1168 my $whole_fpr = $imported_key;
1169 my $long_keyid = substr($imported_key, -16);
1170 my $short_keyid = substr($imported_key, -8);
1172 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1173 $speced_key = $spec if $local_keyids{$spec};
1175 unless ($speced_key) {
1176 notice
("Imported unexpected key; got: $imported_key\n");
1179 debug
("Imported $imported_key for $speced_key");
1180 delete $local_keyids{$speced_key};
1181 unshift @keyids_ok, $imported_key;
1182 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1183 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1184 my $imported_key = $1;
1185 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.");
1188 notice
("got unknown reply from gpg: $line");
1191 if (scalar %local_keyids) {
1192 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1193 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1194 if (scalar keys %local_keyids == 1) {
1195 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1197 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1199 push @keyids_ok, keys %local_keyids;
1203 unless (@keyids_ok) {
1204 notice
("No keys to sign found");
1211 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1212 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1215 unless ($CONFIG{'no-sign'}) {
1216 my @local_user = get_local_user_keys
();
1218 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1219 for my $keyid (@keyids_ok) {
1220 foreach my $local_user (@local_user) {
1222 push @command, $CONFIG{'gpg-sign'};
1223 push @command, '--local-user', $local_user if (defined $local_user);
1224 push @command, "--homedir=$GNUPGHOME";
1225 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1226 push @command, '--no-auto-check-trustdb';
1227 push @command, '--trust-model=always';
1228 push @command, '--edit', $keyid;
1229 push @command, 'sign';
1230 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1231 print join(' ', @command),"\n";
1241 for my $keyid (@keyids_ok) {
1244 my $gpg = GnuPG
::Interface
->new();
1245 $gpg->call( $CONFIG{'gpg'} );
1246 $gpg->options->hash_init(
1247 'homedir' => $GNUPGHOME,
1248 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1249 $gpg->options->meta_interactive( 0 );
1250 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1251 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1252 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1254 if ($stdout eq '') {
1255 warn ("No data from gpg for list-key $keyid\n");
1258 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1259 if (scalar @publine == 0) {
1260 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1263 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1264 if (scalar @publine > 0) {
1265 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1268 unless (defined $longkeyid) {
1269 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1272 unless (defined $flags) {
1273 warn ("Didn't find flags in --list-key of key $keyid.\n");
1276 my $can_encrypt = $flags =~ /E/;
1280 my $asciikey = export_key
($GNUPGHOME, $keyid);
1281 if ($asciikey eq '') {
1282 warn ("No data from gpg for export $keyid\n");
1289 my $this_uid_text = '';
1291 debug
("Doing key $keyid, uid $uid_number");
1292 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1294 # import into temporary gpghome
1295 ###############################
1296 my $result = import_key
($tempdir, $asciikey);
1298 warn ("Could not import $keyid into temporary gnupg.\n");
1304 $gpg = GnuPG
::Interface
->new();
1305 $gpg->call( $CONFIG{'gpg-delsig'} );
1306 $gpg->options->hash_init(
1307 'homedir' => $tempdir,
1308 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1309 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1310 $pid = $gpg->wrap_call(
1311 commands
=> [ '--edit' ],
1312 command_args
=> [ $keyid ],
1313 handles
=> $handles );
1315 debug
("Starting edit session");
1316 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1320 my $number_of_subkeys = 0;
1324 my $delete_some = 0;
1325 debug
("Parsing stdout output.");
1326 for my $line (split /\n/, $stdout) {
1327 debug
("Checking line $line");
1328 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1329 if ($type eq 'sub') {
1330 $number_of_subkeys++;
1332 next unless ($type eq 'uid' || $type eq 'uat');
1333 debug
("line is interesting.");
1334 if ($uid_number != $i) {
1335 debug
("mark for deletion.");
1336 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1341 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1342 $is_uat = $type eq 'uat';
1346 debug
("Parsing stdout output done.");
1347 unless ($have_one) {
1348 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1349 info
("key $keyid done.");
1353 my $prune_some_sigs_on_uid;
1354 my $prune_all_sigs_on_uid;
1356 debug
("handling attribute userid of key $keyid.");
1357 if ($uid_number == 1) {
1358 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1359 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1361 $prune_some_sigs_on_uid = 1;
1362 $prune_all_sigs_on_uid = 2;
1364 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1365 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1367 $prune_some_sigs_on_uid = 2;
1368 $prune_all_sigs_on_uid = 1;
1371 $prune_some_sigs_on_uid = 1;
1375 debug
("need to delete $delete_some uids.");
1376 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1377 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1382 if ($number_of_subkeys > 0) {
1383 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1384 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1386 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1387 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1392 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1393 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1394 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1395 if (defined $prune_all_sigs_on_uid) {
1396 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1397 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1398 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1402 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1405 my $asciikey = export_key
($tempdir, $keyid);
1406 if ($asciikey eq '') {
1407 warn ("No data from gpg for export $keyid\n");
1411 if ($signed_by_me) {
1412 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1413 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1416 my $keydir = "$KEYSBASE/$DATE_STRING";
1417 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1419 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1420 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1421 print KEY
$asciikey;
1424 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1426 info
("$longkeyid $uid_number $this_uid_text done.");
1428 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1432 if (scalar @UIDS == 0) {
1433 info
("found no signed uids for $keyid");
1435 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1438 for my $uid (@UIDS) {
1439 trace
("UID: $uid->{'text'}\n");
1440 if ($uid->{'is_uat'}) {
1441 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1442 push @attached, $uid if $attach;
1443 } elsif ($uid->{'text'} !~ /@/) {
1444 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1445 push @attached, $uid if $attach;
1449 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1450 for my $uid (@UIDS) {
1451 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1452 my $address = $uid->{'text'};
1453 $address =~ s/.*<(.*)>.*/$1/;
1454 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1455 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1456 if (defined $mail) {
1457 my $keydir = "$KEYSBASE/$DATE_STRING";
1458 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1459 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1463 warn "Generating mail failed.\n";
1472 ###########################
1473 # the default mail template
1474 ###########################
1479 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1480 {foreach $uid (@uids) {
1481 $OUT .= "\t".$uid."\n";
1482 };}of your key
{$key} signed by me
.
1484 If you have multiple user ids
, I sent the signature
for each user id
1485 separately to that user id
's associated email address. You can import
1486 the signatures by running each through `gpg --import`.
1488 Note that I did not upload your key to any keyservers. If you want this
1489 new signature to be available to others, please upload it yourself.
1490 With GnuPG this can be done using
1491 gpg --keyserver pool.sks-keyservers.net --send-key {$key}
1493 If you have any questions, don't hesitate to ask
.