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.
87 =item B<--key-file> I<file>
89 Import keys from file. Can be supplied more than once.
97 =item $HOME/.caffrc - configuration file
99 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
101 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
103 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
105 useful options include use-agent, keyserver-options, default-cert-level, etc.
109 =head1 CONFIGURATION FILE OPTIONS
111 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
112 The file is generated when it does not exist.
116 $CONFIG{'owner'} = q{Peter Palfrader};
117 $CONFIG{'email'} = q{peter@palfrader.org};
118 $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
120 =head2 Required basic settings
124 =item B<owner> [string]
126 Your name. B<REQUIRED>.
128 =item B<email> [string]
130 Your email address, used in From: lines. B<REQUIRED>.
132 =item B<keyid> [list of keyids]
134 A list of your keys. This is used to determine which signatures to keep
135 in the pruning step. If you select a key using B<-u> it has to be in
136 this list. B<REQUIRED>.
140 =head2 General settings
144 =item B<caffhome> [string]
146 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
150 =head2 GnuPG settings
154 =item B<gpg> [string]
156 Path to the GnuPG binary. Default: B<gpg>.
158 =item B<gpg-sign> [string]
160 Path to the GnuPG binary which is used to sign keys. Default: what
163 =item B<gpg-delsig> [string]
165 Path to the GnuPG binary which is used to split off signatures. This was
166 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
169 =item B<secret-keyring> [string]
171 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
173 =item B<also-encrypt-to> [keyid, or list of keyids]
175 Additional keyids to encrypt messages to. Default: none.
177 =item B<gpg-sign-args> [string]
179 Additional commands to pass to gpg after the "sign" command.
184 =head2 Keyserver settings
188 =item B<keyserver> [string]
190 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
192 =item B<no-download> [boolean]
194 If true, then skip the step of fetching keys from the keyserver.
197 =item B<key-files> [list of files]
199 A list of files containing keys to be imported.
203 =head2 Signing settings
207 =item B<no-sign> [boolean]
209 If true, then skip the signing step. Default: B<0>.
211 =item B<ask-sign> [boolean]
213 If true, then pause before continuing to the signing step.
214 This is useful for offline signing. Default: B<0>.
216 =item B<export-sig-age> [seconds]
218 Don't export UIDs by default, on which your latest signature is older
219 than this age. Default: B<24*60*60> (i.e. one day).
221 =item B<local-user> [keyid, or list of keyids]
223 Select the key that is used for signing, in case you have more than one key.
224 With multiple keyids, sign with each key in turn.
232 =item B<mail> [boolean]
234 Whether to send mails. This is a quad-option, with which you can set the
235 behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
236 each uid, with according defaults for the question. Default: B<ask-yes>.
238 In any case, the messages are also written to $CONFIG{'caffhome'}/keys/
240 =item B<mail-template> [string]
242 Email template which is used as the body text for the email sent out
243 instead of the default text if specified. The following perl variables
244 can be used in the template:
248 =item B<{owner}> [string]
250 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
252 =item B<{key}> [string]
254 The keyid of the key you signed.
256 =item B<{@uids}> [array]
258 The UIDs for which signatures are included in the mail.
262 =item B<reply-to> [string]
264 Add a Reply-To: header to messages sent. Default: none.
266 =item B<bcc> [string]
268 Address to send blind carbon copies to when sending mail.
271 =item B<mailer-send> [array]
273 Parameters to pass to Mail::Mailer.
274 This could for example be
276 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
278 to use the perl SMTP client or
280 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
282 to pass arguments to the sendmail program.
283 For more information run C<< perldoc Mail::Mailer >>.
284 Setting this option is strongly discouraged. Fix your local MTA
294 =item Peter Palfrader <peter@palfrader.org>
296 =item Christoph Berg <cb@df7cb.de>
302 http://pgp-tools.alioth.debian.org/
306 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
314 use File
::Temp
qw{tempdir
};
321 use GnuPG
::Interface
;
324 my $REVISION = '$Rev$';
325 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
326 my $VERSION = "0.0.0.$REVISION_NUMER";
332 print "[WARN] $line\n";
336 print "[NOTICE] $line\n";
340 print "[INFO] $line\n";
344 #print "[DEBUG] $line\n";
348 #print "[trace] $line\n";
352 #print "[trace2] $line\n";
356 sub generate_config
() {
357 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
358 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
361 # BSD does not have hostname -f, so we try without -f first
362 my $hostname = `hostname`;
363 $hostname = `hostname -f` unless $hostname =~ /\./;
365 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
367 if (defined $gecos) {
370 my $gpg = GnuPG
::Interface
->new();
372 $gpg->options->hash_init(
373 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
374 $gpg->options->meta_interactive( 0 );
375 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
376 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
377 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
381 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
384 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
385 unless (scalar @keys) {
386 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
387 @keys = qw{0123456789abcdef
89abcdef76543210
};
390 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
391 unless (defined $email) {
392 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
393 $email = $ENV{'LOGNAME'}.'@'.$hostname;
397 $gecos = 'Unknown Caff User';
398 $email = $ENV{'LOGNAME'}.'@'.$hostname;
399 @keys = qw{0123456789abcdef
89abcdef76543210
};
400 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
403 my $template = <<EOT;
404 # .caffrc -- vim:ft=perl:
405 # This file is in perl(1) format - see caff(1) for details.
407 $Cgecos\$CONFIG{'owner'} = '$gecos';
408 $Cemail\$CONFIG{'email'} = '$email';
409 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
411 # You can get your long keyid from
412 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
414 # If you have a v4 key, it will simply be the last 16 digits of
418 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
419 # or, if you have more than one key:
420 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
421 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
423 # Select this/these keys to sign with
424 #\$CONFIG{'local-user'} = [ qw{@keys} ];
426 # Additionally encrypt messages for these keyids
427 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
429 # Mail template to use for the encrypted part
430 #\$CONFIG{'mail-template'} = << 'EOM';
433 $template .= "#$_" foreach <DATA
>;
434 $template .= "#EOM\n";
438 sub check_executable
($$) {
439 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
440 # so we want to check manually.)
441 my ($purpose, $fn) = @_;
442 # Only check provided fnames with a slash in them.
443 return unless defined $fn;
445 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
447 for my $p (split(':', $ENV{PATH
})) {
448 return if -x
"$p/$fn";
450 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
455 my $config = $ENV{'HOME'} . '/.caffrc';
456 unless (-f
$config) {
457 print "No configfile $config present, I will use this template:\n";
458 my $template = generate_config
();
459 print "$template\nPlease edit $config and run caff again.\n";
460 open F
, ">$config" or die "$config: $!";
465 unless (scalar eval `cat $config`) {
466 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
469 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
470 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
471 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
472 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
473 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
474 for my $keyid (@
{$CONFIG{'keyid'}}) {
475 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
477 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
478 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
479 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
480 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
481 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
482 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
483 check_executable
("gpg", $CONFIG{'gpg'});
484 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
485 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
486 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
487 unless defined $CONFIG{'secret-keyring'};
488 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
489 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
490 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
491 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
492 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
493 unless (defined $CONFIG{'mail-template'}) {
494 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
496 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
497 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
503 stdin
=> IO
::Handle
->new(),
504 stdout
=> IO
::Handle
->new(),
505 stderr
=> IO
::Handle
->new(),
506 status
=> IO
::Handle
->new() );
507 my $handles = GnuPG
::Handles
->new( %fds );
508 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
511 sub readwrite_gpg
($$$$$%) {
512 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
514 trace
("Entering readwrite_gpg.");
516 my ($first_line, undef) = split /\n/, $in;
517 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
519 local $INPUT_RECORD_SEPARATOR = undef;
520 my $sout = IO
::Select
->new();
521 my $sin = IO
::Select
->new();
524 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
526 $inputfd->blocking(0);
527 $stdoutfd->blocking(0);
528 $statusfd->blocking(0) if defined $statusfd;
529 $stderrfd->blocking(0);
530 $sout->add($stdoutfd);
531 $sout->add($stderrfd);
532 $sout->add($statusfd) if defined $statusfd;
535 my ($stdout, $stderr, $status) = ("", "", "");
536 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
537 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
539 my $readwrote_stuff_this_time = 0;
540 my $do_not_wait_on_select = 0;
541 my ($readyr, $readyw, $written);
542 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
543 if (defined $exitwhenstatusmatches) {
544 if ($status =~ /$exitwhenstatusmatches/m) {
545 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
546 if ($readwrote_stuff_this_time) {
547 trace
("read/write some more\n");
548 $do_not_wait_on_select = 1;
550 trace
("that's it in our while loop.\n");
556 $readwrote_stuff_this_time = 0;
557 trace
("select waiting for ".($sout->count())." fds.");
558 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
559 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
560 for my $wfd (@
$readyw) {
561 $readwrote_stuff_this_time = 1;
562 if (length($in) != $offset) {
563 trace
("writing to $wfd.");
564 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
567 if ($offset == length($in)) {
568 trace
("writing to $wfd done.");
569 unless ($options{'nocloseinput'}) {
571 trace
("$wfd closed.");
578 next unless (defined(@
$readyr)); # Wait some more.
580 for my $rfd (@
$readyr) {
581 $readwrote_stuff_this_time = 1;
583 trace
("reading from $rfd done.");
588 trace
("reading from $rfd.");
589 if ($rfd == $stdoutfd) {
591 trace2
("stdout is now $stdout\n================");
594 if (defined $statusfd && $rfd == $statusfd) {
596 trace2
("status is now $status\n================");
599 if ($rfd == $stderrfd) {
601 trace2
("stderr is now $stderr\n================");
606 trace
("readwrite_gpg done.");
607 return ($stdout, $stderr, $status);
611 my ($question, $default, $forceyes, $forceno) = @_;
613 my $yn = $default ?
'[Y/n]' : '[y/N]';
615 print $question,' ',$yn, ' ';
616 if ($forceyes && $forceno) {
617 print "$default (from config/command line)\n";
621 print "YES (from config/command line)\n";
625 print "NO (from config/command line)\n";
630 if (!defined $answer) {
631 $OUTPUT_AUTOFLUSH = 1;
633 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
634 "so you can't really use it with xargs. A patch against caff to read from\n".
635 "the terminal would be appreciated.\n".
636 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
639 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
640 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
643 my $result = $default;
644 $result = 1 if $answer =~ /y/i;
645 $result = 0 if $answer =~ /n/i;
653 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
654 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
655 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
656 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
657 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
660 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
662 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
663 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
665 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
666 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
669 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
670 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
675 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
679 my ($fd, $exitcode) = @_;
681 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
682 print $fd "Consult the manual page for more information.\n";
687 # export key $keyid from $gnupghome
690 my ($gnupghome, $keyid) = @_;
692 my $gpg = GnuPG
::Interface
->new();
693 $gpg->call( $CONFIG{'gpg'} );
694 if (defined $gnupghome) {
695 $gpg->options->hash_init(
696 'homedir' => $gnupghome,
697 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
700 $gpg->options->hash_init(
701 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
704 $gpg->options->meta_interactive( 0 );
705 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
706 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
707 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
714 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
717 my ($gnupghome, $asciikey) = @_;
719 my $gpg = GnuPG
::Interface
->new();
720 $gpg->call( $CONFIG{'gpg'} );
721 $gpg->options->hash_init(
722 'homedir' => $gnupghome,
723 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
724 $gpg->options->meta_interactive( 0 );
725 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
726 my $pid = $gpg->import_keys(handles
=> $handles);
727 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
730 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
738 # Send an email to $address. If $can_encrypt is true then the mail
739 # will be PGP/MIME encrypted to $longkeyid.
741 # $longkeyid, $uid, and @attached will be used in the email and the template.
743 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
744 sub send_mail
($$$@
) {
745 my ($address, $can_encrypt, $key_id, @keys) = @_;
747 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
748 or die "Error creating template: $Text::Template::ERROR";
751 for my $key (@keys) {
752 push @uids, $key->{'text'};
754 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
756 owner
=> $CONFIG{'owner'}})
757 or die "Error filling template in: $Text::Template::ERROR";
759 my $message_entity = MIME
::Entity
->build(
760 Type
=> "text/plain",
762 Disposition
=> 'inline',
766 for my $key (@keys) {
767 $message_entity->attach(
768 Type
=> "application/pgp-keys",
769 Disposition
=> 'attachment',
771 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
772 Data
=> $key->{'key'},
773 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
777 my $message = $message_entity->stringify();
779 my $gpg = GnuPG
::Interface
->new();
780 $gpg->call( $CONFIG{'gpg'} );
781 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
782 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
784 $gpg->options->meta_interactive( 0 );
785 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
786 $gpg->options->push_recipients( $key_id );
787 if (defined $CONFIG{'also-encrypt-to'}) {
788 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
790 my $pid = $gpg->encrypt(handles
=> $handles);
791 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
794 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
795 (defined $CONFIG{'also-encrypt-to'})) {
798 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
799 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
800 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
801 "or try the following if you are slightly more daring:\n".
802 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
806 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
811 $message_entity = MIME
::Entity
->build(
812 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
815 $message_entity->attach(
816 Type
=> "application/pgp-encrypted",
817 Filename
=> "signedkey.msg",
818 Disposition
=> 'attachment',
820 Data
=> "Version: 1\n");
822 $message_entity->attach(
823 Type
=> "application/octet-stream",
824 Filename
=> 'msg.asc',
825 Disposition
=> 'inline',
830 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
831 $message_entity->head->add("To", $address);
832 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
833 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
834 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
835 $message_entity->head->add("User-Agent", $USER_AGENT);
836 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);
837 $message_entity->send(@
{$CONFIG{'mailer-send'}});
838 $message_entity->stringify();
842 # clean up a UID so that it can be used on the FS.
844 sub sanitize_uid
($) {
848 $good_uid =~ tr
#/:\\#_#;
849 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
853 sub delete_signatures
($$$$$$) {
854 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
856 my $signed_by_me = 0;
858 my ($stdout, $stderr, $status) =
859 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
861 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
862 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
863 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
864 $stdout =~ s/\n/\\n/g;
865 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
866 my $line = pop @sigline;
868 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
869 debug
("[sigremoval] doing line $line.");
870 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
871 if ($signer eq $longkeyid) {
872 debug
("[sigremoval] selfsig ($signer).");
874 } elsif (grep { $signer eq $_ } @
{$keyids}) {
875 debug
("[sigremoval] signed by us ($signer).");
877 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
879 debug
("[sigremoval] not interested in that sig ($signer).");
883 debug
("[sigremoval] no sig line here, only got: ".$stdout);
885 ($stdout, $stderr, $status) =
886 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
889 return $signed_by_me;
899 Getopt
::Long
::config
('bundling');
901 '-h' => \
$params->{'help'},
902 '--help' => \
$params->{'help'},
903 '--version' => \
$params->{'version'},
904 '-V' => \
$params->{'version'},
905 '-u=s' => \
$params->{'local-user'},
906 '--local-user=s' => \
$params->{'local-user'},
907 '-e' => \
$params->{'export-old'},
908 '--export-old' => \
$params->{'export-old'},
909 '-E' => \
$params->{'no-export-old'},
910 '--no-export-old' => \
$params->{'no-export-old'},
911 '-m:s' => \
$params->{'mail'},
912 '--mail:s' => \
$params->{'mail'},
913 '-M' => \
$params->{'no-mail'},
914 '--no-mail' => \
$params->{'no-mail'},
915 '-R' => \
$params->{'no-download'},
916 '--no-download' => \
$params->{'no-download'},
917 '-S' => \
$params->{'no-sign'},
918 '--no-sign' => \
$params->{'no-sign'},
919 '--key-file=s@' => \
$params->{'key-files'},
923 if ($params->{'help'}) {
926 if ($params->{'version'}) {
930 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
932 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
933 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
934 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
936 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
937 if ( $CONFIG{'no-mail'} || defined $params->{'no-mail'} ||
938 ( defined $params->{'mail'} && $params->{'mail'} eq 'no' ) ) {
939 $CONFIG{'mail'} = 'no';
940 } elsif ( defined $params->{'mail'} ) {
941 $CONFIG{'mail'} = $params->{'mail'};
943 $CONFIG{'mail'} = 'ask-yes';
946 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
947 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
949 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
951 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
953 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
954 if ($keyid =~ /^[A-F0-9]{32}$/i) {
955 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
958 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
959 print STDERR
"$keyid is not a keyid.\n";
962 push @KEYIDS, uc($keyid);
968 for my $keyid (@
{$CONFIG{'keyid'}}) {
969 info
("Importing key $keyid from your normal GnuPGHome.");
970 my $key = export_key
(undef, $keyid);
971 if (!defined $key || $key eq '') {
972 warn ("Did not get key $keyid from your normal GnuPGHome\n");
975 my $result = import_key
($GNUPGHOME, $key);
977 warn ("Could not import $keyid into caff's gnupghome.\n");
982 ########################
983 # import keys from files
984 ########################
985 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
986 my $gpg = GnuPG
::Interface
->new();
987 $gpg->call( $CONFIG{'gpg'} );
988 $gpg->options->hash_init('homedir' => $GNUPGHOME);
989 $gpg->options->meta_interactive( 0 );
990 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
991 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
992 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
993 info
("Importing keys from $keyfile");
995 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1000 #############################
1001 # receive keys from keyserver
1002 #############################
1004 if ($CONFIG{'no-download'}) {
1005 @keyids_ok = @KEYIDS;
1007 info
("fetching keys, this will take a while...");
1009 my $gpg = GnuPG
::Interface
->new();
1010 $gpg->call( $CONFIG{'gpg'} );
1011 $gpg->options->hash_init(
1012 'homedir' => $GNUPGHOME,
1013 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1014 $gpg->options->meta_interactive( 0 );
1015 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1016 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1017 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1020 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1023 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1024 my %local_keyids = map { $_ => 1 } @KEYIDS;
1025 my $had_v3_keys = 0;
1026 for my $line (split /\n/, $status) {
1027 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1028 my $imported_key = $1;
1029 my $whole_fpr = $imported_key;
1030 my $long_keyid = substr($imported_key, -16);
1031 my $short_keyid = substr($imported_key, -8);
1033 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1034 $speced_key = $spec if $local_keyids{$spec};
1036 unless ($speced_key) {
1037 notice
("Imported unexpected key; got: $imported_key\n");
1040 debug
("Imported $imported_key for $speced_key");
1041 delete $local_keyids{$speced_key};
1042 unshift @keyids_ok, $imported_key;
1043 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1044 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1045 my $imported_key = $1;
1046 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.");
1049 notice
("got unknown reply from gpg: $line");
1052 if (scalar %local_keyids) {
1053 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1054 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1055 if (scalar keys %local_keyids == 1) {
1056 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1058 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1060 push @keyids_ok, keys %local_keyids;
1064 unless (@keyids_ok) {
1065 notice
("No keys to sign found");
1072 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1073 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1076 unless ($CONFIG{'no-sign'}) {
1078 if ($CONFIG{'local-user'}) {
1079 if (ref($CONFIG{'local-user'})) {
1080 @local_user = @
{$CONFIG{'local-user'}};
1082 @local_user = split /\s*,\s*/, $CONFIG{'local-user'};
1084 foreach (@local_user) {
1086 unless (/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1087 print STDERR
"Local-user $_ is not a keyid.\n";
1093 @local_user = (undef);
1096 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1097 for my $keyid (@keyids_ok) {
1098 foreach my $local_user (@local_user) {
1100 push @command, $CONFIG{'gpg-sign'};
1101 push @command, '--local-user', $local_user if (defined $local_user);
1102 push @command, "--homedir=$GNUPGHOME";
1103 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1104 push @command, '--no-auto-check-trustdb';
1105 push @command, '--trust-model=always';
1106 push @command, '--edit', $keyid;
1107 push @command, 'sign';
1108 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1109 print join(' ', @command),"\n";
1119 for my $keyid (@keyids_ok) {
1122 my $gpg = GnuPG
::Interface
->new();
1123 $gpg->call( $CONFIG{'gpg'} );
1124 $gpg->options->hash_init(
1125 'homedir' => $GNUPGHOME,
1126 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1127 $gpg->options->meta_interactive( 0 );
1128 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1129 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1130 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1132 if ($stdout eq '') {
1133 warn ("No data from gpg for list-key $keyid\n");
1136 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1137 if (scalar @publine == 0) {
1138 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1141 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1142 if (scalar @publine > 0) {
1143 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1146 unless (defined $longkeyid) {
1147 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1150 unless (defined $flags) {
1151 warn ("Didn't find flags in --list-key of key $keyid.\n");
1154 my $can_encrypt = $flags =~ /E/;
1158 my $asciikey = export_key
($GNUPGHOME, $keyid);
1159 if ($asciikey eq '') {
1160 warn ("No data from gpg for export $keyid\n");
1167 my $this_uid_text = '';
1169 debug
("Doing key $keyid, uid $uid_number");
1170 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1172 # import into temporary gpghome
1173 ###############################
1174 my $result = import_key
($tempdir, $asciikey);
1176 warn ("Could not import $keyid into temporary gnupg.\n");
1182 $gpg = GnuPG
::Interface
->new();
1183 $gpg->call( $CONFIG{'gpg-delsig'} );
1184 $gpg->options->hash_init(
1185 'homedir' => $tempdir,
1186 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1187 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1188 $pid = $gpg->wrap_call(
1189 commands
=> [ '--edit' ],
1190 command_args
=> [ $keyid ],
1191 handles
=> $handles );
1193 debug
("Starting edit session");
1194 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1198 my $number_of_subkeys = 0;
1202 my $delete_some = 0;
1203 debug
("Parsing stdout output.");
1204 for my $line (split /\n/, $stdout) {
1205 debug
("Checking line $line");
1206 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1207 if ($type eq 'sub') {
1208 $number_of_subkeys++;
1210 next unless ($type eq 'uid' || $type eq 'uat');
1211 debug
("line is interesting.");
1212 if ($uid_number != $i) {
1213 debug
("mark for deletion.");
1214 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1219 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1220 $is_uat = $type eq 'uat';
1224 debug
("Parsing stdout output done.");
1225 unless ($have_one) {
1226 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1227 info
("key $keyid done.");
1231 my $prune_some_sigs_on_uid;
1232 my $prune_all_sigs_on_uid;
1234 debug
("handling attribute userid of key $keyid.");
1235 if ($uid_number == 1) {
1236 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1237 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1239 $prune_some_sigs_on_uid = 1;
1240 $prune_all_sigs_on_uid = 2;
1242 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1243 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1245 $prune_some_sigs_on_uid = 2;
1246 $prune_all_sigs_on_uid = 1;
1249 $prune_some_sigs_on_uid = 1;
1253 debug
("need to delete $delete_some uids.");
1254 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1255 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1260 if ($number_of_subkeys > 0) {
1261 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1262 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1264 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1265 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1270 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1271 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1272 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1273 if (defined $prune_all_sigs_on_uid) {
1274 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1275 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1276 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1280 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1283 my $asciikey = export_key
($tempdir, $keyid);
1284 if ($asciikey eq '') {
1285 warn ("No data from gpg for export $keyid\n");
1289 if ($signed_by_me) {
1290 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1291 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1294 my $keydir = "$KEYSBASE/$DATE_STRING";
1295 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1297 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1298 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1299 print KEY
$asciikey;
1302 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1304 info
("$longkeyid $uid_number $this_uid_text done.");
1306 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1310 if (scalar @UIDS == 0) {
1311 info
("found no signed uids for $keyid");
1313 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1316 for my $uid (@UIDS) {
1317 trace
("UID: $uid->{'text'}\n");
1318 if ($uid->{'is_uat'}) {
1319 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1320 push @attached, $uid if $attach;
1321 } elsif ($uid->{'text'} !~ /@/) {
1322 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1323 push @attached, $uid if $attach;
1327 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1328 for my $uid (@UIDS) {
1329 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1330 my $address = $uid->{'text'};
1331 $address =~ s/.*<(.*)>.*/$1/;
1332 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1333 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1334 if (defined $mail) {
1335 my $keydir = "$KEYSBASE/$DATE_STRING";
1336 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1337 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1341 warn "Generating mail failed.\n";
1350 ###########################
1351 # the default mail template
1352 ###########################
1357 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1358 {foreach $uid (@uids) {
1359 $OUT .= "\t".$uid."\n";
1360 };}of your key
{$key} signed by me
.
1362 If you have multiple user ids
, I sent the signature
for each user id
1363 separately to that user id
's associated email address. You can import
1364 the signatures by running each through `gpg --import`.
1366 Note that I did not upload your key to any keyservers. If you want this
1367 new signature to be available to others, please upload it yourself.
1368 With GnuPG this can be done using
1369 gpg --keyserver subkeys.pgp.net --send-key {$key}
1371 If you have any questions, don't hesitate to ask
.