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<subkeys.pgp.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";
334 print "[WARN] $line\n";
338 print "[NOTICE] $line\n";
342 print "[INFO] $line\n";
346 #print "[DEBUG] $line\n";
350 #print "[trace] $line\n";
354 #print "[trace2] $line\n";
358 sub generate_config
() {
359 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
360 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
363 # BSD does not have hostname -f, so we try without -f first
364 my $hostname = `hostname`;
365 $hostname = `hostname -f` unless $hostname =~ /\./;
367 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
369 if (defined $gecos) {
372 my $gpg = GnuPG
::Interface
->new();
374 $gpg->options->hash_init(
375 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
376 $gpg->options->meta_interactive( 0 );
377 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
378 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
379 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
383 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
386 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
387 unless (scalar @keys) {
388 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
389 @keys = qw{0123456789abcdef
89abcdef76543210
};
392 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
393 unless (defined $email) {
394 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
395 $email = $ENV{'LOGNAME'}.'@'.$hostname;
399 $gecos = 'Unknown Caff User';
400 $email = $ENV{'LOGNAME'}.'@'.$hostname;
401 @keys = qw{0123456789abcdef
89abcdef76543210
};
402 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
405 my $template = <<EOT;
406 # .caffrc -- vim:ft=perl:
407 # This file is in perl(1) format - see caff(1) for details.
409 $Cgecos\$CONFIG{'owner'} = '$gecos';
410 $Cemail\$CONFIG{'email'} = '$email';
411 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
413 # You can get your long keyid from
414 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
416 # If you have a v4 key, it will simply be the last 16 digits of
420 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
421 # or, if you have more than one key:
422 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
423 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
425 # Select this/these keys to sign with
426 #\$CONFIG{'local-user'} = [ qw{@keys} ];
428 # Additionally encrypt messages for these keyids
429 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
431 # Mail template to use for the encrypted part
432 #\$CONFIG{'mail-template'} = << 'EOM';
435 $template .= "#$_" foreach <DATA
>;
436 $template .= "#EOM\n";
440 sub check_executable
($$) {
441 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
442 # so we want to check manually.)
443 my ($purpose, $fn) = @_;
444 # Only check provided fnames with a slash in them.
445 return unless defined $fn;
447 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
449 for my $p (split(':', $ENV{PATH
})) {
450 return if -x
"$p/$fn";
452 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
457 my $config = $ENV{'HOME'} . '/.caffrc';
458 unless (-f
$config) {
459 print "No configfile $config present, I will use this template:\n";
460 my $template = generate_config
();
461 print "$template\nPlease edit $config and run caff again.\n";
462 open F
, ">$config" or die "$config: $!";
467 unless (scalar eval `cat $config`) {
468 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
471 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
472 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
473 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
474 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
475 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
476 for my $keyid (@
{$CONFIG{'keyid'}}) {
477 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
479 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
480 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
481 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
482 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
483 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
484 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
485 check_executable
("gpg", $CONFIG{'gpg'});
486 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
487 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
488 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
489 unless defined $CONFIG{'secret-keyring'};
490 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
491 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
492 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
493 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
494 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
495 unless (defined $CONFIG{'mail-template'}) {
496 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
498 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
499 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
505 stdin
=> IO
::Handle
->new(),
506 stdout
=> IO
::Handle
->new(),
507 stderr
=> IO
::Handle
->new(),
508 status
=> IO
::Handle
->new() );
509 my $handles = GnuPG
::Handles
->new( %fds );
510 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
513 sub readwrite_gpg
($$$$$%) {
514 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
516 trace
("Entering readwrite_gpg.");
518 my ($first_line, undef) = split /\n/, $in;
519 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
521 local $INPUT_RECORD_SEPARATOR = undef;
522 my $sout = IO
::Select
->new();
523 my $sin = IO
::Select
->new();
526 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
528 $inputfd->blocking(0);
529 $stdoutfd->blocking(0);
530 $statusfd->blocking(0) if defined $statusfd;
531 $stderrfd->blocking(0);
532 $sout->add($stdoutfd);
533 $sout->add($stderrfd);
534 $sout->add($statusfd) if defined $statusfd;
537 my ($stdout, $stderr, $status) = ("", "", "");
538 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
539 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
541 my $readwrote_stuff_this_time = 0;
542 my $do_not_wait_on_select = 0;
543 my ($readyr, $readyw, $written);
544 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
545 if (defined $exitwhenstatusmatches) {
546 if ($status =~ /$exitwhenstatusmatches/m) {
547 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
548 if ($readwrote_stuff_this_time) {
549 trace
("read/write some more\n");
550 $do_not_wait_on_select = 1;
552 trace
("that's it in our while loop.\n");
558 $readwrote_stuff_this_time = 0;
559 trace
("select waiting for ".($sout->count())." fds.");
560 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
561 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
562 for my $wfd (@
$readyw) {
563 $readwrote_stuff_this_time = 1;
564 if (length($in) != $offset) {
565 trace
("writing to $wfd.");
566 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
569 if ($offset == length($in)) {
570 trace
("writing to $wfd done.");
571 unless ($options{'nocloseinput'}) {
573 trace
("$wfd closed.");
580 next unless (defined(@
$readyr)); # Wait some more.
582 for my $rfd (@
$readyr) {
583 $readwrote_stuff_this_time = 1;
585 trace
("reading from $rfd done.");
590 trace
("reading from $rfd.");
591 if ($rfd == $stdoutfd) {
593 trace2
("stdout is now $stdout\n================");
596 if (defined $statusfd && $rfd == $statusfd) {
598 trace2
("status is now $status\n================");
601 if ($rfd == $stderrfd) {
603 trace2
("stderr is now $stderr\n================");
608 trace
("readwrite_gpg done.");
609 return ($stdout, $stderr, $status);
613 my ($question, $default, $forceyes, $forceno) = @_;
615 my $yn = $default ?
'[Y/n]' : '[y/N]';
617 print $question,' ',$yn, ' ';
618 if ($forceyes && $forceno) {
619 print "$default (from config/command line)\n";
623 print "YES (from config/command line)\n";
627 print "NO (from config/command line)\n";
632 if (!defined $answer) {
633 $OUTPUT_AUTOFLUSH = 1;
635 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
636 "so you can't really use it with xargs. A patch against caff to read from\n".
637 "the terminal would be appreciated.\n".
638 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
641 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
642 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
645 my $result = $default;
646 $result = 1 if $answer =~ /y/i;
647 $result = 0 if $answer =~ /n/i;
655 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
656 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
657 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
658 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
659 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
662 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
664 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
665 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
667 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
668 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
671 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
672 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
677 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
681 my ($fd, $exitcode) = @_;
683 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
684 print $fd "Consult the manual page for more information.\n";
689 # export key $keyid from $gnupghome
692 my ($gnupghome, $keyid) = @_;
694 my $gpg = GnuPG
::Interface
->new();
695 $gpg->call( $CONFIG{'gpg'} );
696 if (defined $gnupghome) {
697 $gpg->options->hash_init(
698 'homedir' => $gnupghome,
699 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
702 $gpg->options->hash_init(
703 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
706 $gpg->options->meta_interactive( 0 );
707 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
708 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
709 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
716 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
719 my ($gnupghome, $asciikey) = @_;
721 my $gpg = GnuPG
::Interface
->new();
722 $gpg->call( $CONFIG{'gpg'} );
723 $gpg->options->hash_init(
724 'homedir' => $gnupghome,
725 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
726 $gpg->options->meta_interactive( 0 );
727 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
728 my $pid = $gpg->import_keys(handles
=> $handles);
729 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
732 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
740 # Send an email to $address. If $can_encrypt is true then the mail
741 # will be PGP/MIME encrypted to $longkeyid.
743 # $longkeyid, $uid, and @attached will be used in the email and the template.
745 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
746 sub send_mail
($$$@
) {
747 my ($address, $can_encrypt, $key_id, @keys) = @_;
749 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
750 or die "Error creating template: $Text::Template::ERROR";
753 for my $key (@keys) {
754 push @uids, $key->{'text'};
756 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
758 owner
=> $CONFIG{'owner'}})
759 or die "Error filling template in: $Text::Template::ERROR";
761 my $message_entity = MIME
::Entity
->build(
762 Type
=> "text/plain",
764 Disposition
=> 'inline',
768 for my $key (@keys) {
769 $message_entity->attach(
770 Type
=> "application/pgp-keys",
771 Disposition
=> 'attachment',
773 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
774 Data
=> $key->{'key'},
775 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
779 my $message = $message_entity->stringify();
781 my $gpg = GnuPG
::Interface
->new();
782 $gpg->call( $CONFIG{'gpg'} );
783 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
784 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
786 $gpg->options->meta_interactive( 0 );
787 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
788 $gpg->options->push_recipients( $key_id );
789 if (defined $CONFIG{'also-encrypt-to'}) {
790 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
792 my $pid = $gpg->encrypt(handles
=> $handles);
793 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
796 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
797 (defined $CONFIG{'also-encrypt-to'})) {
800 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
801 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
802 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
803 "or try the following if you are slightly more daring:\n".
804 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
808 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
813 $message_entity = MIME
::Entity
->build(
814 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
817 $message_entity->attach(
818 Type
=> "application/pgp-encrypted",
819 Filename
=> "signedkey.msg",
820 Disposition
=> 'attachment',
822 Data
=> "Version: 1\n");
824 $message_entity->attach(
825 Type
=> "application/octet-stream",
826 Filename
=> 'msg.asc',
827 Disposition
=> 'inline',
832 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
833 $message_entity->head->add("To", $address);
834 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
835 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
836 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
837 $message_entity->head->add("User-Agent", $USER_AGENT);
838 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);
839 $message_entity->send(@
{$CONFIG{'mailer-send'}});
840 $message_entity->stringify();
844 # clean up a UID so that it can be used on the FS.
846 sub sanitize_uid
($) {
850 $good_uid =~ tr
#/:\\#_#;
851 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
855 sub delete_signatures
($$$$$$) {
856 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
858 my $signed_by_me = 0;
860 my ($stdout, $stderr, $status) =
861 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
863 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
864 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
865 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
866 $stdout =~ s/\n/\\n/g;
867 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
868 my $line = pop @sigline;
870 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
871 debug
("[sigremoval] doing line $line.");
872 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
873 if ($signer eq $longkeyid) {
874 debug
("[sigremoval] selfsig ($signer).");
876 } elsif (grep { $signer eq $_ } @
{$keyids}) {
877 debug
("[sigremoval] signed by us ($signer).");
879 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
881 debug
("[sigremoval] not interested in that sig ($signer).");
885 debug
("[sigremoval] no sig line here, only got: ".$stdout);
887 ($stdout, $stderr, $status) =
888 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
891 return $signed_by_me;
901 Getopt
::Long
::config
('bundling');
903 '-h' => \
$params->{'help'},
904 '--help' => \
$params->{'help'},
905 '--version' => \
$params->{'version'},
906 '-V' => \
$params->{'version'},
907 '-u=s' => \
$params->{'local-user'},
908 '--local-user=s' => \
$params->{'local-user'},
909 '-e' => \
$params->{'export-old'},
910 '--export-old' => \
$params->{'export-old'},
911 '-E' => \
$params->{'no-export-old'},
912 '--no-export-old' => \
$params->{'no-export-old'},
913 '-m:s' => \
$params->{'mail'},
914 '--mail:s' => \
$params->{'mail'},
915 '-M' => \
$params->{'no-mail'},
916 '--no-mail' => \
$params->{'no-mail'},
917 '-R' => \
$params->{'no-download'},
918 '--no-download' => \
$params->{'no-download'},
919 '-S' => \
$params->{'no-sign'},
920 '--no-sign' => \
$params->{'no-sign'},
921 '--key-file=s@' => \
$params->{'key-files'},
925 if ($params->{'help'}) {
928 if ($params->{'version'}) {
932 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
934 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
935 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
936 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
938 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
939 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
941 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
942 if ( defined $CONFIG{'no-mail'} ||
943 ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) {
944 $CONFIG{'mail'} = 'no';
946 } elsif ( !defined $CONFIG{'mail'} ) {
947 $CONFIG{'mail'} = 'ask-yes';
950 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
952 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
954 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
955 if ($keyid =~ /^[A-F0-9]{32}$/i) {
956 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
959 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
960 print STDERR
"$keyid is not a keyid.\n";
963 push @KEYIDS, uc($keyid);
969 for my $keyid (@
{$CONFIG{'keyid'}}) {
970 info
("Importing key $keyid from your normal GnuPGHome.");
971 my $key = export_key
(undef, $keyid);
972 if (!defined $key || $key eq '') {
973 warn ("Did not get key $keyid from your normal GnuPGHome\n");
976 my $result = import_key
($GNUPGHOME, $key);
978 warn ("Could not import $keyid into caff's gnupghome.\n");
983 ########################
984 # import keys from files
985 ########################
986 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
987 my $gpg = GnuPG
::Interface
->new();
988 $gpg->call( $CONFIG{'gpg'} );
989 $gpg->options->hash_init('homedir' => $GNUPGHOME);
990 $gpg->options->meta_interactive( 0 );
991 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
992 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
993 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
994 info
("Importing keys from $keyfile");
996 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1001 #############################
1002 # receive keys from keyserver
1003 #############################
1005 if ($CONFIG{'no-download'}) {
1006 @keyids_ok = @KEYIDS;
1008 info
("fetching keys, this will take a while...");
1010 my $gpg = GnuPG
::Interface
->new();
1011 $gpg->call( $CONFIG{'gpg'} );
1012 $gpg->options->hash_init(
1013 'homedir' => $GNUPGHOME,
1014 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1015 $gpg->options->meta_interactive( 0 );
1016 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1017 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1018 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1021 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1024 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1025 my %local_keyids = map { $_ => 1 } @KEYIDS;
1026 my $had_v3_keys = 0;
1027 for my $line (split /\n/, $status) {
1028 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1029 my $imported_key = $1;
1030 my $whole_fpr = $imported_key;
1031 my $long_keyid = substr($imported_key, -16);
1032 my $short_keyid = substr($imported_key, -8);
1034 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1035 $speced_key = $spec if $local_keyids{$spec};
1037 unless ($speced_key) {
1038 notice
("Imported unexpected key; got: $imported_key\n");
1041 debug
("Imported $imported_key for $speced_key");
1042 delete $local_keyids{$speced_key};
1043 unshift @keyids_ok, $imported_key;
1044 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1045 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1046 my $imported_key = $1;
1047 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.");
1050 notice
("got unknown reply from gpg: $line");
1053 if (scalar %local_keyids) {
1054 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1055 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1056 if (scalar keys %local_keyids == 1) {
1057 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1059 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1061 push @keyids_ok, keys %local_keyids;
1065 unless (@keyids_ok) {
1066 notice
("No keys to sign found");
1073 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1074 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1077 unless ($CONFIG{'no-sign'}) {
1079 if ($CONFIG{'local-user'}) {
1080 if (ref($CONFIG{'local-user'})) {
1081 @local_user = @
{$CONFIG{'local-user'}};
1083 @local_user = split /\s*,\s*/, $CONFIG{'local-user'};
1085 foreach (@local_user) {
1087 unless (/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1088 print STDERR
"Local-user $_ is not a keyid.\n";
1094 @local_user = (undef);
1097 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1098 for my $keyid (@keyids_ok) {
1099 foreach my $local_user (@local_user) {
1101 push @command, $CONFIG{'gpg-sign'};
1102 push @command, '--local-user', $local_user if (defined $local_user);
1103 push @command, "--homedir=$GNUPGHOME";
1104 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1105 push @command, '--no-auto-check-trustdb';
1106 push @command, '--trust-model=always';
1107 push @command, '--edit', $keyid;
1108 push @command, 'sign';
1109 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1110 print join(' ', @command),"\n";
1120 for my $keyid (@keyids_ok) {
1123 my $gpg = GnuPG
::Interface
->new();
1124 $gpg->call( $CONFIG{'gpg'} );
1125 $gpg->options->hash_init(
1126 'homedir' => $GNUPGHOME,
1127 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1128 $gpg->options->meta_interactive( 0 );
1129 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1130 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1131 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1133 if ($stdout eq '') {
1134 warn ("No data from gpg for list-key $keyid\n");
1137 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1138 if (scalar @publine == 0) {
1139 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1142 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1143 if (scalar @publine > 0) {
1144 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1147 unless (defined $longkeyid) {
1148 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1151 unless (defined $flags) {
1152 warn ("Didn't find flags in --list-key of key $keyid.\n");
1155 my $can_encrypt = $flags =~ /E/;
1159 my $asciikey = export_key
($GNUPGHOME, $keyid);
1160 if ($asciikey eq '') {
1161 warn ("No data from gpg for export $keyid\n");
1168 my $this_uid_text = '';
1170 debug
("Doing key $keyid, uid $uid_number");
1171 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1173 # import into temporary gpghome
1174 ###############################
1175 my $result = import_key
($tempdir, $asciikey);
1177 warn ("Could not import $keyid into temporary gnupg.\n");
1183 $gpg = GnuPG
::Interface
->new();
1184 $gpg->call( $CONFIG{'gpg-delsig'} );
1185 $gpg->options->hash_init(
1186 'homedir' => $tempdir,
1187 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1188 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1189 $pid = $gpg->wrap_call(
1190 commands
=> [ '--edit' ],
1191 command_args
=> [ $keyid ],
1192 handles
=> $handles );
1194 debug
("Starting edit session");
1195 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1199 my $number_of_subkeys = 0;
1203 my $delete_some = 0;
1204 debug
("Parsing stdout output.");
1205 for my $line (split /\n/, $stdout) {
1206 debug
("Checking line $line");
1207 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1208 if ($type eq 'sub') {
1209 $number_of_subkeys++;
1211 next unless ($type eq 'uid' || $type eq 'uat');
1212 debug
("line is interesting.");
1213 if ($uid_number != $i) {
1214 debug
("mark for deletion.");
1215 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1220 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1221 $is_uat = $type eq 'uat';
1225 debug
("Parsing stdout output done.");
1226 unless ($have_one) {
1227 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1228 info
("key $keyid done.");
1232 my $prune_some_sigs_on_uid;
1233 my $prune_all_sigs_on_uid;
1235 debug
("handling attribute userid of key $keyid.");
1236 if ($uid_number == 1) {
1237 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1238 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1240 $prune_some_sigs_on_uid = 1;
1241 $prune_all_sigs_on_uid = 2;
1243 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1244 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1246 $prune_some_sigs_on_uid = 2;
1247 $prune_all_sigs_on_uid = 1;
1250 $prune_some_sigs_on_uid = 1;
1254 debug
("need to delete $delete_some uids.");
1255 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1256 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1261 if ($number_of_subkeys > 0) {
1262 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1263 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1265 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1266 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1271 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1272 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1273 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1274 if (defined $prune_all_sigs_on_uid) {
1275 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1276 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1277 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1281 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1284 my $asciikey = export_key
($tempdir, $keyid);
1285 if ($asciikey eq '') {
1286 warn ("No data from gpg for export $keyid\n");
1290 if ($signed_by_me) {
1291 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1292 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1295 my $keydir = "$KEYSBASE/$DATE_STRING";
1296 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1298 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1299 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1300 print KEY
$asciikey;
1303 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1305 info
("$longkeyid $uid_number $this_uid_text done.");
1307 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1311 if (scalar @UIDS == 0) {
1312 info
("found no signed uids for $keyid");
1314 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1317 for my $uid (@UIDS) {
1318 trace
("UID: $uid->{'text'}\n");
1319 if ($uid->{'is_uat'}) {
1320 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1321 push @attached, $uid if $attach;
1322 } elsif ($uid->{'text'} !~ /@/) {
1323 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1324 push @attached, $uid if $attach;
1328 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1329 for my $uid (@UIDS) {
1330 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1331 my $address = $uid->{'text'};
1332 $address =~ s/.*<(.*)>.*/$1/;
1333 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1334 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1335 if (defined $mail) {
1336 my $keydir = "$KEYSBASE/$DATE_STRING";
1337 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1338 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1342 warn "Generating mail failed.\n";
1351 ###########################
1352 # the default mail template
1353 ###########################
1358 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1359 {foreach $uid (@uids) {
1360 $OUT .= "\t".$uid."\n";
1361 };}of your key
{$key} signed by me
.
1363 If you have multiple user ids
, I sent the signature
for each user id
1364 separately to that user id
's associated email address. You can import
1365 the signatures by running each through `gpg --import`.
1367 Note that I did not upload your key to any keyservers. If you want this
1368 new signature to be available to others, please upload it yourself.
1369 With GnuPG this can be done using
1370 gpg --keyserver subkeys.pgp.net --send-key {$key}
1372 If you have any questions, don't hesitate to ask
.