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/
316 use File
::Temp
qw{tempdir
};
323 use GnuPG
::Interface
;
326 my $REVISION = '$Rev$';
327 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
328 $REVISION_NUMER = 'unknown' unless defined $REVISION_NUMER;
329 my $VERSION = "0.0.0.$REVISION_NUMER";
336 # Display an error message on STDERR and then exit.
338 # @param $exitcode exit code status to use to end the program
339 # @param $line error message to display on STDERR
342 my ($exitcode, $line) = @_;
343 print "[ERROR] $line\n";
349 print "[WARN] $line\n";
353 print "[NOTICE] $line\n";
357 print "[INFO] $line\n";
361 #print "[DEBUG] $line\n";
365 #print "[trace] $line\n";
369 #print "[trace2] $line\n";
373 sub generate_config
() {
374 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
375 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
378 # BSD does not have hostname -f, so we try without -f first
379 my $hostname = `hostname`;
380 $hostname = `hostname -f` unless $hostname =~ /\./;
382 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
384 if (defined $gecos) {
387 my $gpg = GnuPG
::Interface
->new();
389 $gpg->options->hash_init(
390 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
391 $gpg->options->meta_interactive( 0 );
392 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
393 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
394 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
398 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
401 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
402 unless (scalar @keys) {
403 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
404 @keys = qw{0123456789abcdef
89abcdef76543210
};
407 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
408 unless (defined $email) {
409 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
410 $email = $ENV{'LOGNAME'}.'@'.$hostname;
414 $gecos = 'Unknown Caff User';
415 $email = $ENV{'LOGNAME'}.'@'.$hostname;
416 @keys = qw{0123456789abcdef
89abcdef76543210
};
417 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
420 my $template = <<EOT;
421 # .caffrc -- vim:ft=perl:
422 # This file is in perl(1) format - see caff(1) for details.
424 $Cgecos\$CONFIG{'owner'} = '$gecos';
425 $Cemail\$CONFIG{'email'} = '$email';
426 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
428 # You can get your long keyid from
429 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
431 # If you have a v4 key, it will simply be the last 16 digits of
435 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
436 # or, if you have more than one key:
437 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
438 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
440 # Select this/these keys to sign with
441 #\$CONFIG{'local-user'} = [ qw{@keys} ];
443 # Additionally encrypt messages for these keyids
444 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
446 # Mail template to use for the encrypted part
447 #\$CONFIG{'mail-template'} = << 'EOM';
450 $template .= "#$_" foreach <DATA
>;
451 $template .= "#EOM\n";
455 sub check_executable
($$) {
456 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
457 # so we want to check manually.)
458 my ($purpose, $fn) = @_;
459 # Only check provided fnames with a slash in them.
460 return unless defined $fn;
462 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
464 for my $p (split(':', $ENV{PATH
})) {
465 return if -x
"$p/$fn";
467 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
472 my $config = $ENV{'HOME'} . '/.caffrc';
473 unless (-f
$config) {
474 print "No configfile $config present, I will use this template:\n";
475 my $template = generate_config
();
476 print "$template\nPlease edit $config and run caff again.\n";
477 open F
, ">$config" or die "$config: $!";
482 unless (scalar eval `cat $config`) {
483 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
486 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
487 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
488 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
489 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
490 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
491 for my $keyid (@
{$CONFIG{'keyid'}}) {
492 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
494 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
495 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
496 $CONFIG{'keyserver'} = 'pool.sks-keyservers.net' unless defined $CONFIG{'keyserver'};
497 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
498 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
499 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
500 check_executable
("gpg", $CONFIG{'gpg'});
501 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
502 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
503 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
504 unless defined $CONFIG{'secret-keyring'};
505 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
506 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
507 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
508 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
509 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
510 unless (defined $CONFIG{'mail-template'}) {
511 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
513 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
514 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
520 stdin
=> IO
::Handle
->new(),
521 stdout
=> IO
::Handle
->new(),
522 stderr
=> IO
::Handle
->new(),
523 status
=> IO
::Handle
->new() );
524 my $handles = GnuPG
::Handles
->new( %fds );
525 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
528 sub readwrite_gpg
($$$$$%) {
529 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
531 trace
("Entering readwrite_gpg.");
533 my ($first_line, undef) = split /\n/, $in;
534 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
536 local $INPUT_RECORD_SEPARATOR = undef;
537 my $sout = IO
::Select
->new();
538 my $sin = IO
::Select
->new();
541 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
543 $inputfd->blocking(0);
544 $stdoutfd->blocking(0);
545 $statusfd->blocking(0) if defined $statusfd;
546 $stderrfd->blocking(0);
547 $sout->add($stdoutfd);
548 $sout->add($stderrfd);
549 $sout->add($statusfd) if defined $statusfd;
552 my ($stdout, $stderr, $status) = ("", "", "");
553 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
554 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
556 my $readwrote_stuff_this_time = 0;
557 my $do_not_wait_on_select = 0;
558 my ($readyr, $readyw, $written);
559 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
560 if (defined $exitwhenstatusmatches) {
561 if ($status =~ /$exitwhenstatusmatches/m) {
562 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
563 if ($readwrote_stuff_this_time) {
564 trace
("read/write some more\n");
565 $do_not_wait_on_select = 1;
567 trace
("that's it in our while loop.\n");
573 $readwrote_stuff_this_time = 0;
574 trace
("select waiting for ".($sout->count())." fds.");
575 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
576 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
577 for my $wfd (@
$readyw) {
578 $readwrote_stuff_this_time = 1;
579 if (length($in) != $offset) {
580 trace
("writing to $wfd.");
581 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
584 if ($offset == length($in)) {
585 trace
("writing to $wfd done.");
586 unless ($options{'nocloseinput'}) {
588 trace
("$wfd closed.");
595 next unless (defined(@
$readyr)); # Wait some more.
597 for my $rfd (@
$readyr) {
598 $readwrote_stuff_this_time = 1;
600 trace
("reading from $rfd done.");
605 trace
("reading from $rfd.");
606 if ($rfd == $stdoutfd) {
608 trace2
("stdout is now $stdout\n================");
611 if (defined $statusfd && $rfd == $statusfd) {
613 trace2
("status is now $status\n================");
616 if ($rfd == $stderrfd) {
618 trace2
("stderr is now $stderr\n================");
623 trace
("readwrite_gpg done.");
624 return ($stdout, $stderr, $status);
628 my ($question, $default, $forceyes, $forceno) = @_;
630 my $yn = $default ?
'[Y/n]' : '[y/N]';
632 print $question,' ',$yn, ' ';
633 if ($forceyes && $forceno) {
634 print "$default (from config/command line)\n";
638 print "YES (from config/command line)\n";
642 print "NO (from config/command line)\n";
647 if (!defined $answer) {
648 $OUTPUT_AUTOFLUSH = 1;
650 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
651 "so you can't really use it with xargs. A patch against caff to read from\n".
652 "the terminal would be appreciated.\n".
653 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
656 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
657 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
660 my $result = $default;
661 $result = 1 if $answer =~ /y/i;
662 $result = 0 if $answer =~ /n/i;
670 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
671 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
672 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
673 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
674 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
677 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
679 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
680 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
682 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
683 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
686 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
687 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
692 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
696 my ($fd, $exitcode) = @_;
698 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
699 print $fd "Consult the manual page for more information.\n";
704 # export key $keyid from $gnupghome
707 my ($gnupghome, $keyid) = @_;
709 my $gpg = GnuPG
::Interface
->new();
710 $gpg->call( $CONFIG{'gpg'} );
711 if (defined $gnupghome) {
712 $gpg->options->hash_init(
713 'homedir' => $gnupghome,
714 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
717 $gpg->options->hash_init(
718 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
721 $gpg->options->meta_interactive( 0 );
722 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
723 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
724 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
731 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
734 my ($gnupghome, $asciikey) = @_;
736 my $gpg = GnuPG
::Interface
->new();
737 $gpg->call( $CONFIG{'gpg'} );
738 $gpg->options->hash_init(
739 'homedir' => $gnupghome,
740 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
741 $gpg->options->meta_interactive( 0 );
742 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
743 my $pid = $gpg->import_keys(handles
=> $handles);
744 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
747 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
755 # Send an email to $address. If $can_encrypt is true then the mail
756 # will be PGP/MIME encrypted to $longkeyid.
758 # $longkeyid, $uid, and @attached will be used in the email and the template.
760 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
761 sub send_mail
($$$@
) {
762 my ($address, $can_encrypt, $key_id, @keys) = @_;
764 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
765 or die "Error creating template: $Text::Template::ERROR";
768 for my $key (@keys) {
769 push @uids, $key->{'text'};
771 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
773 owner
=> $CONFIG{'owner'}})
774 or die "Error filling template in: $Text::Template::ERROR";
776 my $message_entity = MIME
::Entity
->build(
777 Type
=> "text/plain",
779 Disposition
=> 'inline',
783 for my $key (@keys) {
784 $message_entity->attach(
785 Type
=> "application/pgp-keys",
786 Disposition
=> 'attachment',
788 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
789 Data
=> $key->{'key'},
790 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
794 my $message = $message_entity->stringify();
796 my $gpg = GnuPG
::Interface
->new();
797 $gpg->call( $CONFIG{'gpg'} );
798 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
799 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
801 $gpg->options->meta_interactive( 0 );
802 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
803 $gpg->options->push_recipients( $key_id );
804 if (defined $CONFIG{'also-encrypt-to'}) {
805 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
807 my $pid = $gpg->encrypt(handles
=> $handles);
808 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
811 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
812 (defined $CONFIG{'also-encrypt-to'})) {
815 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
816 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
817 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
818 "or try the following if you are slightly more daring:\n".
819 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
823 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
828 $message_entity = MIME
::Entity
->build(
829 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
832 $message_entity->attach(
833 Type
=> "application/pgp-encrypted",
834 Filename
=> "signedkey.msg",
835 Disposition
=> 'attachment',
837 Data
=> "Version: 1\n");
839 $message_entity->attach(
840 Type
=> "application/octet-stream",
841 Filename
=> 'msg.asc',
842 Disposition
=> 'inline',
847 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
848 $message_entity->head->add("To", $address);
849 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
850 $message_entity->head->add("Sender", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
851 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
852 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
853 $message_entity->head->add("User-Agent", $USER_AGENT);
854 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);
855 $message_entity->send(@
{$CONFIG{'mailer-send'}});
856 $message_entity->stringify();
860 # clean up a UID so that it can be used on the FS.
862 sub sanitize_uid
($) {
866 $good_uid =~ tr
#/:\\#_#;
867 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
871 sub delete_signatures
($$$$$$) {
872 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
874 my $signed_by_me = 0;
876 my ($stdout, $stderr, $status) =
877 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
879 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
880 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
881 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
882 $stdout =~ s/\n/\\n/g;
883 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
884 my $line = pop @sigline;
886 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
887 debug
("[sigremoval] doing line $line.");
888 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
889 if ($signer eq $longkeyid) {
890 debug
("[sigremoval] selfsig ($signer).");
892 } elsif (grep { $signer eq $_ } @
{$keyids}) {
893 debug
("[sigremoval] signed by us ($signer).");
895 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
897 debug
("[sigremoval] not interested in that sig ($signer).");
901 debug
("[sigremoval] no sig line here, only got: ".$stdout);
903 ($stdout, $stderr, $status) =
904 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
907 return $signed_by_me;
911 # Check the local user keys.
913 # This function checks if the keyids defined through the --local-user
914 # command line option or set in ~/.caffrc are valid and known to be one of the
915 # keyids listed in ~/.caffrc.
917 # @return an array containing the local user keys\n
918 # (undef) if no valid key has been found
920 sub get_local_user_keys
() {
924 # No user-defined key id has been specified by the user, no need for
926 if (!$CONFIG{'local-user'}) {
930 # Parse the list of keys
931 if (ref($CONFIG{'local-user'})) {
932 @key_list = @
{$CONFIG{'local-user'}};
935 @key_list = split /\s*,\s*/, $CONFIG{'local-user'};
938 # Check every key defined by the user...
939 for my $user_key (@key_list) {
941 $user_key =~ s/^0x//i;
942 $user_key = uc($user_key);
944 unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) {
945 mywarn
"Local-user $user_key is not a valid keyid.";
949 unless (grep (/$user_key$/, @
{$CONFIG{'keyid'}})) {
950 mywarn
"Local-user $user_key is not defined as one of your keyid in ~/.caffrc (it will not be used).";
954 push (@local_user, $user_key);
957 # If no local-user key are valid, there is no need to go further
958 unless (defined $local_user[0]) {
959 myerror
(1, "None of the local-user keys seem to be known as a keyid listed in ~/.caffrc.");
966 # Import a key from the user gnupghome into a specified gnupghome.
968 # @param asciikey ascii format of the gpg key to import
969 # @param dst_gnupghome gnupghome directory where to import the key
971 # @return 0 if successful\n
972 # 1 if the key could not be exported.\n
973 # 2 if the key could not be imported.
975 sub import_key_from_user_gnupghome
($$) {
977 my ($asciikey, $dst_gpghome) = @_;
979 trace
("Exporting key $asciikey from your normal GnuPGHOME.");
980 my $key = export_key
(undef, $asciikey);
981 if (defined $key && $key ne '') {
982 trace
("Importing key $asciikey into $GNUPGHOME.");
983 if (import_key
($GNUPGHOME, $key)) {
986 warn("Could not import $asciikey into caff's gnupghome.");
997 # Import a key file into a specified gnupghome.
999 # @param keyfile file containing the keys to import
1000 # @param dst_gnupghome gnupghome directory where to import the key
1002 # @return 0 if successful\n
1003 # 1 if an error occured.
1005 sub import_key_files
($$) {
1007 my ($keyfile, $dst_gpghome) = @_;
1009 my $gpg = GnuPG
::Interface
->new();
1010 $gpg->call( $CONFIG{'gpg'} );
1011 $gpg->options->hash_init(
1012 'homedir' => $dst_gpghome,
1013 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
1014 $gpg->options->meta_interactive( 0 );
1015 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1016 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
1017 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1018 info
("Importing keys from file $keyfile");
1021 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1032 # Import keys to be signed into caff gnupghome directory.
1034 # This function imports the keys the user wants to sign into the caff gnupghome
1035 # directory. We looks for the keys in the the user gnupghome directory first,
1036 # and in the key files specified by the user if not all of the keys have been
1039 sub import_keys_to_sign
() {
1040 # Check if we can find the gpg key from our normal gnupghome, and then
1041 # try to import it into our working gnupghome directory
1042 foreach my $keyid (@KEYIDS) {
1043 if (!import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1044 info
("Key $keyid imported from your normal GnuPGHOME.");
1048 # Import user specified key files
1049 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
1050 import_key_files
($keyfile, $GNUPGHOME);
1059 Getopt
::Long
::config
('bundling');
1061 '-h' => \
$params->{'help'},
1062 '--help' => \
$params->{'help'},
1063 '--version' => \
$params->{'version'},
1064 '-V' => \
$params->{'version'},
1065 '-u=s' => \
$params->{'local-user'},
1066 '--local-user=s' => \
$params->{'local-user'},
1067 '-e' => \
$params->{'export-old'},
1068 '--export-old' => \
$params->{'export-old'},
1069 '-E' => \
$params->{'no-export-old'},
1070 '--no-export-old' => \
$params->{'no-export-old'},
1071 '-m:s' => \
$params->{'mail'},
1072 '--mail:s' => \
$params->{'mail'},
1073 '-M' => \
$params->{'no-mail'},
1074 '--no-mail' => \
$params->{'no-mail'},
1075 '-R' => \
$params->{'no-download'},
1076 '--no-download' => \
$params->{'no-download'},
1077 '-S' => \
$params->{'no-sign'},
1078 '--no-sign' => \
$params->{'no-sign'},
1079 '--key-file=s@' => \
$params->{'key-files'},
1083 if ($params->{'help'}) {
1086 if ($params->{'version'}) {
1090 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
1092 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
1093 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
1094 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
1096 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
1097 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
1099 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
1100 if ( defined $CONFIG{'no-mail'} ||
1101 ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) {
1102 $CONFIG{'mail'} = 'no';
1104 } elsif ( !defined $CONFIG{'mail'} ) {
1105 $CONFIG{'mail'} = 'ask-yes';
1108 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
1110 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
1112 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
1113 if ($keyid =~ /^[A-F0-9]{32}$/i) {
1114 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
1117 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1118 print STDERR
"$keyid is not a keyid.\n";
1121 push @KEYIDS, uc($keyid);
1127 for my $keyid (@
{$CONFIG{'keyid'}}) {
1128 info
("Importing key $keyid from your normal GnuPGHome.");
1129 if (import_key_from_user_gnupghome
($keyid, $GNUPGHOME)) {
1130 mywarn
("Key $keyid not found.");
1134 &import_keys_to_sign
();
1136 #############################
1137 # receive keys from keyserver
1138 #############################
1140 if ($CONFIG{'no-download'}) {
1141 @keyids_ok = @KEYIDS;
1143 info
("fetching keys, this will take a while...");
1145 my $gpg = GnuPG
::Interface
->new();
1146 $gpg->call( $CONFIG{'gpg'} );
1147 $gpg->options->hash_init(
1148 'homedir' => $GNUPGHOME,
1149 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1150 $gpg->options->meta_interactive( 0 );
1151 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1152 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1153 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1156 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1159 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1160 my %local_keyids = map { $_ => 1 } @KEYIDS;
1161 my $had_v3_keys = 0;
1162 for my $line (split /\n/, $status) {
1163 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1164 my $imported_key = $1;
1165 my $whole_fpr = $imported_key;
1166 my $long_keyid = substr($imported_key, -16);
1167 my $short_keyid = substr($imported_key, -8);
1169 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1170 $speced_key = $spec if $local_keyids{$spec};
1172 unless ($speced_key) {
1173 notice
("Imported unexpected key; got: $imported_key\n");
1176 debug
("Imported $imported_key for $speced_key");
1177 delete $local_keyids{$speced_key};
1178 unshift @keyids_ok, $imported_key;
1179 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1180 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1181 my $imported_key = $1;
1182 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.");
1185 notice
("got unknown reply from gpg: $line");
1188 if (scalar %local_keyids) {
1189 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1190 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1191 if (scalar keys %local_keyids == 1) {
1192 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1194 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1196 push @keyids_ok, keys %local_keyids;
1200 unless (@keyids_ok) {
1201 notice
("No keys to sign found");
1208 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1209 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1212 unless ($CONFIG{'no-sign'}) {
1213 my @local_user = get_local_user_keys
();
1215 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1216 for my $keyid (@keyids_ok) {
1217 foreach my $local_user (@local_user) {
1219 push @command, $CONFIG{'gpg-sign'};
1220 push @command, '--local-user', $local_user if (defined $local_user);
1221 push @command, "--homedir=$GNUPGHOME";
1222 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1223 push @command, '--no-auto-check-trustdb';
1224 push @command, '--trust-model=always';
1225 push @command, '--edit', $keyid;
1226 push @command, 'sign';
1227 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1228 print join(' ', @command),"\n";
1238 for my $keyid (@keyids_ok) {
1241 my $gpg = GnuPG
::Interface
->new();
1242 $gpg->call( $CONFIG{'gpg'} );
1243 $gpg->options->hash_init(
1244 'homedir' => $GNUPGHOME,
1245 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1246 $gpg->options->meta_interactive( 0 );
1247 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1248 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1249 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1251 if ($stdout eq '') {
1252 warn ("No data from gpg for list-key $keyid\n");
1255 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1256 if (scalar @publine == 0) {
1257 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1260 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1261 if (scalar @publine > 0) {
1262 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1265 unless (defined $longkeyid) {
1266 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1269 unless (defined $flags) {
1270 warn ("Didn't find flags in --list-key of key $keyid.\n");
1273 my $can_encrypt = $flags =~ /E/;
1277 my $asciikey = export_key
($GNUPGHOME, $keyid);
1278 if ($asciikey eq '') {
1279 warn ("No data from gpg for export $keyid\n");
1286 my $this_uid_text = '';
1288 debug
("Doing key $keyid, uid $uid_number");
1289 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1291 # import into temporary gpghome
1292 ###############################
1293 my $result = import_key
($tempdir, $asciikey);
1295 warn ("Could not import $keyid into temporary gnupg.\n");
1301 $gpg = GnuPG
::Interface
->new();
1302 $gpg->call( $CONFIG{'gpg-delsig'} );
1303 $gpg->options->hash_init(
1304 'homedir' => $tempdir,
1305 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1306 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1307 $pid = $gpg->wrap_call(
1308 commands
=> [ '--edit' ],
1309 command_args
=> [ $keyid ],
1310 handles
=> $handles );
1312 debug
("Starting edit session");
1313 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1317 my $number_of_subkeys = 0;
1321 my $delete_some = 0;
1322 debug
("Parsing stdout output.");
1323 for my $line (split /\n/, $stdout) {
1324 debug
("Checking line $line");
1325 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1326 if ($type eq 'sub') {
1327 $number_of_subkeys++;
1329 next unless ($type eq 'uid' || $type eq 'uat');
1330 debug
("line is interesting.");
1331 if ($uid_number != $i) {
1332 debug
("mark for deletion.");
1333 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1338 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1339 $is_uat = $type eq 'uat';
1343 debug
("Parsing stdout output done.");
1344 unless ($have_one) {
1345 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1346 info
("key $keyid done.");
1350 my $prune_some_sigs_on_uid;
1351 my $prune_all_sigs_on_uid;
1353 debug
("handling attribute userid of key $keyid.");
1354 if ($uid_number == 1) {
1355 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1356 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1358 $prune_some_sigs_on_uid = 1;
1359 $prune_all_sigs_on_uid = 2;
1361 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1362 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1364 $prune_some_sigs_on_uid = 2;
1365 $prune_all_sigs_on_uid = 1;
1368 $prune_some_sigs_on_uid = 1;
1372 debug
("need to delete $delete_some uids.");
1373 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1374 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1379 if ($number_of_subkeys > 0) {
1380 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1381 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1383 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1384 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1389 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1390 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1391 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1392 if (defined $prune_all_sigs_on_uid) {
1393 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1394 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1395 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1399 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1402 my $asciikey = export_key
($tempdir, $keyid);
1403 if ($asciikey eq '') {
1404 warn ("No data from gpg for export $keyid\n");
1408 if ($signed_by_me) {
1409 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1410 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1413 my $keydir = "$KEYSBASE/$DATE_STRING";
1414 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1416 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1417 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1418 print KEY
$asciikey;
1421 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1423 info
("$longkeyid $uid_number $this_uid_text done.");
1425 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1429 if (scalar @UIDS == 0) {
1430 info
("found no signed uids for $keyid");
1432 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1435 for my $uid (@UIDS) {
1436 trace
("UID: $uid->{'text'}\n");
1437 if ($uid->{'is_uat'}) {
1438 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1439 push @attached, $uid if $attach;
1440 } elsif ($uid->{'text'} !~ /@/) {
1441 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1442 push @attached, $uid if $attach;
1446 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1447 for my $uid (@UIDS) {
1448 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1449 my $address = $uid->{'text'};
1450 $address =~ s/.*<(.*)>.*/$1/;
1451 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1452 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1453 if (defined $mail) {
1454 my $keydir = "$KEYSBASE/$DATE_STRING";
1455 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1456 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1460 warn "Generating mail failed.\n";
1469 ###########################
1470 # the default mail template
1471 ###########################
1476 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1477 {foreach $uid (@uids) {
1478 $OUT .= "\t".$uid."\n";
1479 };}of your key
{$key} signed by me
.
1481 If you have multiple user ids
, I sent the signature
for each user id
1482 separately to that user id
's associated email address. You can import
1483 the signatures by running each through `gpg --import`.
1485 Note that I did not upload your key to any keyservers. If you want this
1486 new signature to be available to others, please upload it yourself.
1487 With GnuPG this can be done using
1488 gpg --keyserver pool.sks-keyservers.net --send-key {$key}
1490 If you have any questions, don't hesitate to ask
.