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.
99 =item $HOME/.caffrc - configuration file
101 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
103 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
105 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
107 useful options include use-agent, keyserver-options, default-cert-level, etc.
111 =head1 CONFIGURATION FILE OPTIONS
113 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
114 The file is generated when it does not exist.
118 $CONFIG{'owner'} = q{Peter Palfrader};
119 $CONFIG{'email'} = q{peter@palfrader.org};
120 $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
122 =head2 Required basic settings
126 =item B<owner> [string]
128 Your name. B<REQUIRED>.
130 =item B<email> [string]
132 Your email address, used in From: lines. B<REQUIRED>.
134 =item B<keyid> [list of keyids]
136 A list of your keys. This is used to determine which signatures to keep
137 in the pruning step. If you select a key using B<-u> it has to be in
138 this list. B<REQUIRED>.
142 =head2 General settings
146 =item B<caffhome> [string]
148 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
152 =head2 GnuPG settings
156 =item B<gpg> [string]
158 Path to the GnuPG binary. Default: B<gpg>.
160 =item B<gpg-sign> [string]
162 Path to the GnuPG binary which is used to sign keys. Default: what
165 =item B<gpg-delsig> [string]
167 Path to the GnuPG binary which is used to split off signatures. This was
168 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
171 =item B<secret-keyring> [string]
173 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
175 =item B<also-encrypt-to> [keyid, or list of keyids]
177 Additional keyids to encrypt messages to. Default: none.
179 =item B<gpg-sign-args> [string]
181 Additional commands to pass to gpg after the "sign" command.
186 =head2 Keyserver settings
190 =item B<keyserver> [string]
192 Keyserver to download keys from. Default: B<pool.sks-keyservers.net>.
194 =item B<no-download> [boolean]
196 If true, then skip the step of fetching keys from the keyserver.
199 =item B<key-files> [list of files]
201 A list of files containing keys to be imported.
205 =head2 Signing settings
209 =item B<no-sign> [boolean]
211 If true, then skip the signing step. Default: B<0>.
213 =item B<ask-sign> [boolean]
215 If true, then pause before continuing to the signing step.
216 This is useful for offline signing. Default: B<0>.
218 =item B<export-sig-age> [seconds]
220 Don't export UIDs by default, on which your latest signature is older
221 than this age. Default: B<24*60*60> (i.e. one day).
223 =item B<local-user> [keyid, or list of keyids]
225 Select the key that is used for signing, in case you have more than one key.
226 With multiple keyids, sign with each key in turn.
234 =item B<mail> [boolean]
236 Whether to send mails. This is a quad-option, with which you can set the
237 behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
238 each uid, with according defaults for the question. Default: B<ask-yes>.
240 In any case, the messages are also written to $CONFIG{'caffhome'}/keys/
242 =item B<mail-template> [string]
244 Email template which is used as the body text for the email sent out
245 instead of the default text if specified. The following perl variables
246 can be used in the template:
250 =item B<{owner}> [string]
252 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
254 =item B<{key}> [string]
256 The keyid of the key you signed.
258 =item B<{@uids}> [array]
260 The UIDs for which signatures are included in the mail.
264 =item B<reply-to> [string]
266 Add a Reply-To: header to messages sent. Default: none.
268 =item B<bcc> [string]
270 Address to send blind carbon copies to when sending mail.
273 =item B<mailer-send> [array]
275 Parameters to pass to Mail::Mailer.
276 This could for example be
278 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
280 to use the perl SMTP client or
282 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
284 to pass arguments to the sendmail program.
285 For more information run C<< perldoc Mail::Mailer >>.
286 Setting this option is strongly discouraged. Fix your local MTA
296 =item Peter Palfrader <peter@palfrader.org>
298 =item Christoph Berg <cb@df7cb.de>
304 http://pgp-tools.alioth.debian.org/
308 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
316 use File
::Temp
qw{tempdir
};
323 use GnuPG
::Interface
;
326 my $REVISION = '$Rev$';
327 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
328 my $VERSION = "0.0.0.$REVISION_NUMER";
335 # Display an error message on STDERR and then exit.
337 # @param $exitcode exit code status to use to end the program
338 # @param $line error message to display on STDERR
341 my ($exitcode, $line) = @_;
342 print "[ERROR] $line\n";
348 print "[WARN] $line\n";
352 print "[NOTICE] $line\n";
356 print "[INFO] $line\n";
360 #print "[DEBUG] $line\n";
364 #print "[trace] $line\n";
368 #print "[trace2] $line\n";
372 sub generate_config
() {
373 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
374 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
377 # BSD does not have hostname -f, so we try without -f first
378 my $hostname = `hostname`;
379 $hostname = `hostname -f` unless $hostname =~ /\./;
381 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
383 if (defined $gecos) {
386 my $gpg = GnuPG
::Interface
->new();
388 $gpg->options->hash_init(
389 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
390 $gpg->options->meta_interactive( 0 );
391 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
392 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
393 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
397 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
400 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
401 unless (scalar @keys) {
402 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
403 @keys = qw{0123456789abcdef
89abcdef76543210
};
406 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
407 unless (defined $email) {
408 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
409 $email = $ENV{'LOGNAME'}.'@'.$hostname;
413 $gecos = 'Unknown Caff User';
414 $email = $ENV{'LOGNAME'}.'@'.$hostname;
415 @keys = qw{0123456789abcdef
89abcdef76543210
};
416 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
419 my $template = <<EOT;
420 # .caffrc -- vim:ft=perl:
421 # This file is in perl(1) format - see caff(1) for details.
423 $Cgecos\$CONFIG{'owner'} = '$gecos';
424 $Cemail\$CONFIG{'email'} = '$email';
425 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
427 # You can get your long keyid from
428 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
430 # If you have a v4 key, it will simply be the last 16 digits of
434 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
435 # or, if you have more than one key:
436 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
437 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
439 # Select this/these keys to sign with
440 #\$CONFIG{'local-user'} = [ qw{@keys} ];
442 # Additionally encrypt messages for these keyids
443 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
445 # Mail template to use for the encrypted part
446 #\$CONFIG{'mail-template'} = << 'EOM';
449 $template .= "#$_" foreach <DATA
>;
450 $template .= "#EOM\n";
454 sub check_executable
($$) {
455 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
456 # so we want to check manually.)
457 my ($purpose, $fn) = @_;
458 # Only check provided fnames with a slash in them.
459 return unless defined $fn;
461 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
463 for my $p (split(':', $ENV{PATH
})) {
464 return if -x
"$p/$fn";
466 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
471 my $config = $ENV{'HOME'} . '/.caffrc';
472 unless (-f
$config) {
473 print "No configfile $config present, I will use this template:\n";
474 my $template = generate_config
();
475 print "$template\nPlease edit $config and run caff again.\n";
476 open F
, ">$config" or die "$config: $!";
481 unless (scalar eval `cat $config`) {
482 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
485 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
486 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
487 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
488 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
489 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
490 for my $keyid (@
{$CONFIG{'keyid'}}) {
491 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
493 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
494 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
495 $CONFIG{'keyserver'} = 'pool.sks-keyservers.net' unless defined $CONFIG{'keyserver'};
496 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
497 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
498 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
499 check_executable
("gpg", $CONFIG{'gpg'});
500 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
501 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
502 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
503 unless defined $CONFIG{'secret-keyring'};
504 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
505 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
506 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
507 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
508 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
509 unless (defined $CONFIG{'mail-template'}) {
510 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
512 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
513 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
519 stdin
=> IO
::Handle
->new(),
520 stdout
=> IO
::Handle
->new(),
521 stderr
=> IO
::Handle
->new(),
522 status
=> IO
::Handle
->new() );
523 my $handles = GnuPG
::Handles
->new( %fds );
524 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
527 sub readwrite_gpg
($$$$$%) {
528 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
530 trace
("Entering readwrite_gpg.");
532 my ($first_line, undef) = split /\n/, $in;
533 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
535 local $INPUT_RECORD_SEPARATOR = undef;
536 my $sout = IO
::Select
->new();
537 my $sin = IO
::Select
->new();
540 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
542 $inputfd->blocking(0);
543 $stdoutfd->blocking(0);
544 $statusfd->blocking(0) if defined $statusfd;
545 $stderrfd->blocking(0);
546 $sout->add($stdoutfd);
547 $sout->add($stderrfd);
548 $sout->add($statusfd) if defined $statusfd;
551 my ($stdout, $stderr, $status) = ("", "", "");
552 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
553 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
555 my $readwrote_stuff_this_time = 0;
556 my $do_not_wait_on_select = 0;
557 my ($readyr, $readyw, $written);
558 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
559 if (defined $exitwhenstatusmatches) {
560 if ($status =~ /$exitwhenstatusmatches/m) {
561 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
562 if ($readwrote_stuff_this_time) {
563 trace
("read/write some more\n");
564 $do_not_wait_on_select = 1;
566 trace
("that's it in our while loop.\n");
572 $readwrote_stuff_this_time = 0;
573 trace
("select waiting for ".($sout->count())." fds.");
574 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
575 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
576 for my $wfd (@
$readyw) {
577 $readwrote_stuff_this_time = 1;
578 if (length($in) != $offset) {
579 trace
("writing to $wfd.");
580 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
583 if ($offset == length($in)) {
584 trace
("writing to $wfd done.");
585 unless ($options{'nocloseinput'}) {
587 trace
("$wfd closed.");
594 next unless (defined(@
$readyr)); # Wait some more.
596 for my $rfd (@
$readyr) {
597 $readwrote_stuff_this_time = 1;
599 trace
("reading from $rfd done.");
604 trace
("reading from $rfd.");
605 if ($rfd == $stdoutfd) {
607 trace2
("stdout is now $stdout\n================");
610 if (defined $statusfd && $rfd == $statusfd) {
612 trace2
("status is now $status\n================");
615 if ($rfd == $stderrfd) {
617 trace2
("stderr is now $stderr\n================");
622 trace
("readwrite_gpg done.");
623 return ($stdout, $stderr, $status);
627 my ($question, $default, $forceyes, $forceno) = @_;
629 my $yn = $default ?
'[Y/n]' : '[y/N]';
631 print $question,' ',$yn, ' ';
632 if ($forceyes && $forceno) {
633 print "$default (from config/command line)\n";
637 print "YES (from config/command line)\n";
641 print "NO (from config/command line)\n";
646 if (!defined $answer) {
647 $OUTPUT_AUTOFLUSH = 1;
649 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
650 "so you can't really use it with xargs. A patch against caff to read from\n".
651 "the terminal would be appreciated.\n".
652 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
655 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
656 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
659 my $result = $default;
660 $result = 1 if $answer =~ /y/i;
661 $result = 0 if $answer =~ /n/i;
669 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
670 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
671 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
672 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
673 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
676 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
678 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
679 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
681 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
682 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
685 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
686 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
691 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
695 my ($fd, $exitcode) = @_;
697 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
698 print $fd "Consult the manual page for more information.\n";
703 # export key $keyid from $gnupghome
706 my ($gnupghome, $keyid) = @_;
708 my $gpg = GnuPG
::Interface
->new();
709 $gpg->call( $CONFIG{'gpg'} );
710 if (defined $gnupghome) {
711 $gpg->options->hash_init(
712 'homedir' => $gnupghome,
713 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
716 $gpg->options->hash_init(
717 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
720 $gpg->options->meta_interactive( 0 );
721 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
722 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
723 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
730 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
733 my ($gnupghome, $asciikey) = @_;
735 my $gpg = GnuPG
::Interface
->new();
736 $gpg->call( $CONFIG{'gpg'} );
737 $gpg->options->hash_init(
738 'homedir' => $gnupghome,
739 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
740 $gpg->options->meta_interactive( 0 );
741 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
742 my $pid = $gpg->import_keys(handles
=> $handles);
743 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
746 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
754 # Send an email to $address. If $can_encrypt is true then the mail
755 # will be PGP/MIME encrypted to $longkeyid.
757 # $longkeyid, $uid, and @attached will be used in the email and the template.
759 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
760 sub send_mail
($$$@
) {
761 my ($address, $can_encrypt, $key_id, @keys) = @_;
763 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
764 or die "Error creating template: $Text::Template::ERROR";
767 for my $key (@keys) {
768 push @uids, $key->{'text'};
770 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
772 owner
=> $CONFIG{'owner'}})
773 or die "Error filling template in: $Text::Template::ERROR";
775 my $message_entity = MIME
::Entity
->build(
776 Type
=> "text/plain",
778 Disposition
=> 'inline',
782 for my $key (@keys) {
783 $message_entity->attach(
784 Type
=> "application/pgp-keys",
785 Disposition
=> 'attachment',
787 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
788 Data
=> $key->{'key'},
789 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
793 my $message = $message_entity->stringify();
795 my $gpg = GnuPG
::Interface
->new();
796 $gpg->call( $CONFIG{'gpg'} );
797 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
798 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
800 $gpg->options->meta_interactive( 0 );
801 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
802 $gpg->options->push_recipients( $key_id );
803 if (defined $CONFIG{'also-encrypt-to'}) {
804 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
806 my $pid = $gpg->encrypt(handles
=> $handles);
807 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
810 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
811 (defined $CONFIG{'also-encrypt-to'})) {
814 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
815 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
816 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
817 "or try the following if you are slightly more daring:\n".
818 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
822 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
827 $message_entity = MIME
::Entity
->build(
828 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
831 $message_entity->attach(
832 Type
=> "application/pgp-encrypted",
833 Filename
=> "signedkey.msg",
834 Disposition
=> 'attachment',
836 Data
=> "Version: 1\n");
838 $message_entity->attach(
839 Type
=> "application/octet-stream",
840 Filename
=> 'msg.asc',
841 Disposition
=> 'inline',
846 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
847 $message_entity->head->add("To", $address);
848 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
849 $message_entity->head->add("Sender", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
850 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
851 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
852 $message_entity->head->add("User-Agent", $USER_AGENT);
853 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);
854 $message_entity->send(@
{$CONFIG{'mailer-send'}});
855 $message_entity->stringify();
859 # clean up a UID so that it can be used on the FS.
861 sub sanitize_uid
($) {
865 $good_uid =~ tr
#/:\\#_#;
866 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
870 sub delete_signatures
($$$$$$) {
871 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
873 my $signed_by_me = 0;
875 my ($stdout, $stderr, $status) =
876 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
878 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
879 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
880 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
881 $stdout =~ s/\n/\\n/g;
882 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
883 my $line = pop @sigline;
885 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
886 debug
("[sigremoval] doing line $line.");
887 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
888 if ($signer eq $longkeyid) {
889 debug
("[sigremoval] selfsig ($signer).");
891 } elsif (grep { $signer eq $_ } @
{$keyids}) {
892 debug
("[sigremoval] signed by us ($signer).");
894 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
896 debug
("[sigremoval] not interested in that sig ($signer).");
900 debug
("[sigremoval] no sig line here, only got: ".$stdout);
902 ($stdout, $stderr, $status) =
903 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
906 return $signed_by_me;
910 # Check the local user keys.
912 # This function checks if the keyids defined through the --local-user
913 # command line option or set in ~/.caffrc are valid and known to be one of the
914 # keyids listed in ~/.caffrc.
916 # @return an array containing the local user keys\n
917 # (undef) if no valid key has been found
919 sub get_local_user_keys
() {
923 # No user-defined key id has been specified by the user, no need for
925 if (!$CONFIG{'local-user'}) {
929 # Parse the list of keys
930 if (ref($CONFIG{'local-user'})) {
931 @key_list = @
{$CONFIG{'local-user'}};
934 @key_list = split /\s*,\s*/, $CONFIG{'local-user'};
937 # Check every key defined by the user...
938 for my $user_key (@key_list) {
940 $user_key =~ s/^0x//i;
941 $user_key = uc($user_key);
943 unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) {
944 mywarn
"Local-user $user_key is not a valid keyid.";
948 unless (grep (/$user_key$/, @
{$CONFIG{'keyid'}})) {
949 mywarn
"Local-user $user_key is not defined as one of your keyid in ~/.caffrc (it will not be used).";
953 push (@local_user, $user_key);
956 # If no local-user key are valid, there is no need to go further
957 unless (defined $local_user[0]) {
958 myerror
(1, "None of the local-user keys seem to be known as a keyid listed in ~/.caffrc.");
965 # Import a key from the user gnupghome into a specified gnupghome.
967 # @param asciikey ascii format of the gpg key to import
968 # @param dst_gnupghome gnupghome directory where to import the key
970 # @return 0 if successful\n
971 # 1 if the key could not be exported.\n
972 # 2 if the key could not be imported.
974 sub import_key_from_user_gnupghome
() {
976 my ($asciikey, $dst_gpghome) = @_;
978 trace
("Exporting key $asciikey from your normal GnuPGHOME.");
979 my $key = export_key
(undef, $asciikey);
980 if (defined $key && $key ne '') {
981 trace
("Importing key $asciikey into $GNUPGHOME.");
982 if (import_key
($GNUPGHOME, $key)) {
985 warn("Could not import $asciikey into caff's gnupghome.");
996 # Import a key file into a specified gnupghome.
998 # @param keyfile file containing the keys to import
999 # @param dst_gnupghome gnupghome directory where to import the key
1001 # @return 0 if successful\n
1002 # 1 if an error occured.
1004 sub import_key_files
() {
1006 my ($keyfile, $dst_gpghome) = @_;
1008 my $gpg = GnuPG
::Interface
->new();
1009 $gpg->call( $CONFIG{'gpg'} );
1010 $gpg->options->hash_init(
1011 'homedir' => $dst_gpghome,
1012 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
1013 $gpg->options->meta_interactive( 0 );
1014 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1015 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
1016 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1017 info
("Importing keys from file $keyfile");
1020 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1031 # Import keys to be signed into caff gnupghome directory.
1033 # This function imports the keys the user wants to sign into the caff gnupghome
1034 # directory. We looks for the keys in the the user gnupghome directory first,
1035 # and in the key files specified by the user if not all of the keys have been
1038 sub import_keys_to_sign
() {
1039 # Check if we can find the gpg key from our normal gnupghome, and then
1040 # try to import it into our working gnupghome directory
1041 my $imported_keys = 0;
1042 foreach my $keyid (@KEYIDS) {
1043 if (!&import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1044 info
("Key $keyid imported from your normal GnuPGHOME.");
1049 # If all of the keys have been successfully imported, there is no need to
1051 return 1 if ($imported_keys == scalar (@KEYIDS));
1053 # Import user specified key files
1054 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
1055 &import_key_files
($keyfile, $GNUPGHOME);
1064 Getopt
::Long
::config
('bundling');
1066 '-h' => \
$params->{'help'},
1067 '--help' => \
$params->{'help'},
1068 '--version' => \
$params->{'version'},
1069 '-V' => \
$params->{'version'},
1070 '-u=s' => \
$params->{'local-user'},
1071 '--local-user=s' => \
$params->{'local-user'},
1072 '-e' => \
$params->{'export-old'},
1073 '--export-old' => \
$params->{'export-old'},
1074 '-E' => \
$params->{'no-export-old'},
1075 '--no-export-old' => \
$params->{'no-export-old'},
1076 '-m:s' => \
$params->{'mail'},
1077 '--mail:s' => \
$params->{'mail'},
1078 '-M' => \
$params->{'no-mail'},
1079 '--no-mail' => \
$params->{'no-mail'},
1080 '-R' => \
$params->{'no-download'},
1081 '--no-download' => \
$params->{'no-download'},
1082 '-S' => \
$params->{'no-sign'},
1083 '--no-sign' => \
$params->{'no-sign'},
1084 '--key-file=s@' => \
$params->{'key-files'},
1088 if ($params->{'help'}) {
1091 if ($params->{'version'}) {
1095 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
1097 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
1098 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
1099 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
1101 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
1102 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
1104 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
1105 if ( defined $CONFIG{'no-mail'} ||
1106 ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) {
1107 $CONFIG{'mail'} = 'no';
1109 } elsif ( !defined $CONFIG{'mail'} ) {
1110 $CONFIG{'mail'} = 'ask-yes';
1113 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
1115 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
1117 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
1118 if ($keyid =~ /^[A-F0-9]{32}$/i) {
1119 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
1122 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1123 print STDERR
"$keyid is not a keyid.\n";
1126 push @KEYIDS, uc($keyid);
1132 for my $keyid (@
{$CONFIG{'keyid'}}) {
1133 info
("Importing key $keyid from your normal GnuPGHome.");
1134 if (&import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1135 mywarn
("Key $keyid not found.");
1139 &import_keys_to_sign
();
1141 #############################
1142 # receive keys from keyserver
1143 #############################
1145 if ($CONFIG{'no-download'}) {
1146 @keyids_ok = @KEYIDS;
1148 info
("fetching keys, this will take a while...");
1150 my $gpg = GnuPG
::Interface
->new();
1151 $gpg->call( $CONFIG{'gpg'} );
1152 $gpg->options->hash_init(
1153 'homedir' => $GNUPGHOME,
1154 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1155 $gpg->options->meta_interactive( 0 );
1156 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1157 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1158 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1161 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1164 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1165 my %local_keyids = map { $_ => 1 } @KEYIDS;
1166 my $had_v3_keys = 0;
1167 for my $line (split /\n/, $status) {
1168 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1169 my $imported_key = $1;
1170 my $whole_fpr = $imported_key;
1171 my $long_keyid = substr($imported_key, -16);
1172 my $short_keyid = substr($imported_key, -8);
1174 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1175 $speced_key = $spec if $local_keyids{$spec};
1177 unless ($speced_key) {
1178 notice
("Imported unexpected key; got: $imported_key\n");
1181 debug
("Imported $imported_key for $speced_key");
1182 delete $local_keyids{$speced_key};
1183 unshift @keyids_ok, $imported_key;
1184 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1185 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1186 my $imported_key = $1;
1187 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.");
1190 notice
("got unknown reply from gpg: $line");
1193 if (scalar %local_keyids) {
1194 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1195 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1196 if (scalar keys %local_keyids == 1) {
1197 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1199 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1201 push @keyids_ok, keys %local_keyids;
1205 unless (@keyids_ok) {
1206 notice
("No keys to sign found");
1213 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1214 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1217 unless ($CONFIG{'no-sign'}) {
1218 my @local_user = &get_local_user_keys
();
1220 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1221 for my $keyid (@keyids_ok) {
1222 foreach my $local_user (@local_user) {
1224 push @command, $CONFIG{'gpg-sign'};
1225 push @command, '--local-user', $local_user if (defined $local_user);
1226 push @command, "--homedir=$GNUPGHOME";
1227 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1228 push @command, '--no-auto-check-trustdb';
1229 push @command, '--trust-model=always';
1230 push @command, '--edit', $keyid;
1231 push @command, 'sign';
1232 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1233 print join(' ', @command),"\n";
1243 for my $keyid (@keyids_ok) {
1246 my $gpg = GnuPG
::Interface
->new();
1247 $gpg->call( $CONFIG{'gpg'} );
1248 $gpg->options->hash_init(
1249 'homedir' => $GNUPGHOME,
1250 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1251 $gpg->options->meta_interactive( 0 );
1252 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1253 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1254 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1256 if ($stdout eq '') {
1257 warn ("No data from gpg for list-key $keyid\n");
1260 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1261 if (scalar @publine == 0) {
1262 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1265 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1266 if (scalar @publine > 0) {
1267 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1270 unless (defined $longkeyid) {
1271 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1274 unless (defined $flags) {
1275 warn ("Didn't find flags in --list-key of key $keyid.\n");
1278 my $can_encrypt = $flags =~ /E/;
1282 my $asciikey = export_key
($GNUPGHOME, $keyid);
1283 if ($asciikey eq '') {
1284 warn ("No data from gpg for export $keyid\n");
1291 my $this_uid_text = '';
1293 debug
("Doing key $keyid, uid $uid_number");
1294 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1296 # import into temporary gpghome
1297 ###############################
1298 my $result = import_key
($tempdir, $asciikey);
1300 warn ("Could not import $keyid into temporary gnupg.\n");
1306 $gpg = GnuPG
::Interface
->new();
1307 $gpg->call( $CONFIG{'gpg-delsig'} );
1308 $gpg->options->hash_init(
1309 'homedir' => $tempdir,
1310 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1311 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1312 $pid = $gpg->wrap_call(
1313 commands
=> [ '--edit' ],
1314 command_args
=> [ $keyid ],
1315 handles
=> $handles );
1317 debug
("Starting edit session");
1318 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1322 my $number_of_subkeys = 0;
1326 my $delete_some = 0;
1327 debug
("Parsing stdout output.");
1328 for my $line (split /\n/, $stdout) {
1329 debug
("Checking line $line");
1330 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1331 if ($type eq 'sub') {
1332 $number_of_subkeys++;
1334 next unless ($type eq 'uid' || $type eq 'uat');
1335 debug
("line is interesting.");
1336 if ($uid_number != $i) {
1337 debug
("mark for deletion.");
1338 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1343 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1344 $is_uat = $type eq 'uat';
1348 debug
("Parsing stdout output done.");
1349 unless ($have_one) {
1350 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1351 info
("key $keyid done.");
1355 my $prune_some_sigs_on_uid;
1356 my $prune_all_sigs_on_uid;
1358 debug
("handling attribute userid of key $keyid.");
1359 if ($uid_number == 1) {
1360 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1361 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1363 $prune_some_sigs_on_uid = 1;
1364 $prune_all_sigs_on_uid = 2;
1366 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1367 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1369 $prune_some_sigs_on_uid = 2;
1370 $prune_all_sigs_on_uid = 1;
1373 $prune_some_sigs_on_uid = 1;
1377 debug
("need to delete $delete_some uids.");
1378 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1379 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1384 if ($number_of_subkeys > 0) {
1385 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1386 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1388 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1389 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1394 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1395 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1396 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1397 if (defined $prune_all_sigs_on_uid) {
1398 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1399 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1400 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1404 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1407 my $asciikey = export_key
($tempdir, $keyid);
1408 if ($asciikey eq '') {
1409 warn ("No data from gpg for export $keyid\n");
1413 if ($signed_by_me) {
1414 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1415 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1418 my $keydir = "$KEYSBASE/$DATE_STRING";
1419 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1421 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1422 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1423 print KEY
$asciikey;
1426 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1428 info
("$longkeyid $uid_number $this_uid_text done.");
1430 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1434 if (scalar @UIDS == 0) {
1435 info
("found no signed uids for $keyid");
1437 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1440 for my $uid (@UIDS) {
1441 trace
("UID: $uid->{'text'}\n");
1442 if ($uid->{'is_uat'}) {
1443 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1444 push @attached, $uid if $attach;
1445 } elsif ($uid->{'text'} !~ /@/) {
1446 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1447 push @attached, $uid if $attach;
1451 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1452 for my $uid (@UIDS) {
1453 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1454 my $address = $uid->{'text'};
1455 $address =~ s/.*<(.*)>.*/$1/;
1456 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1457 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1458 if (defined $mail) {
1459 my $keydir = "$KEYSBASE/$DATE_STRING";
1460 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1461 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1465 warn "Generating mail failed.\n";
1474 ###########################
1475 # the default mail template
1476 ###########################
1481 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1482 {foreach $uid (@uids) {
1483 $OUT .= "\t".$uid."\n";
1484 };}of your key
{$key} signed by me
.
1486 If you have multiple user ids
, I sent the signature
for each user id
1487 separately to that user id
's associated email address. You can import
1488 the signatures by running each through `gpg --import`.
1490 Note that I did not upload your key to any keyservers. If you want this
1491 new signature to be available to others, please upload it yourself.
1492 With GnuPG this can be done using
1493 gpg --keyserver pool.sks-keyservers.net --send-key {$key}
1495 If you have any questions, don't hesitate to ask
.