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> [-eEmMRS] [-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>
71 Send mail after signing. Default is to ask the user for each uid.
73 =item B<-M>, B<--no-mail>
75 Do not send mail after signing. Default is to ask the user for each uid.
77 =item B<-R>, B<--no-download>
79 Do not retrieve the key to be signed from a keyserver.
81 =item B<-S>, B<--no-sign>
85 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
87 Select the key that is used for signing, in case you have more than one key.
88 To sign with multiple keys at once, separate multiple keyids by comma.
90 =item B<--key-file> I<file>
92 Import keys from file. Can be supplied more than once.
100 =item $HOME/.caffrc - configuration file
102 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
104 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
106 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
108 useful options include use-agent, keyserver-options, default-cert-level, etc.
112 =head1 CONFIGURATION FILE OPTIONS
114 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
115 The file is generated when it does not exist.
119 $CONFIG{'owner'} = q{Peter Palfrader};
120 $CONFIG{'email'} = q{peter@palfrader.org};
121 $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
123 =head2 Required basic settings
127 =item B<owner> [string]
129 Your name. B<REQUIRED>.
131 =item B<email> [string]
133 Your email address, used in From: lines. B<REQUIRED>.
135 =item B<keyid> [list of keyids]
137 A list of your keys. This is used to determine which signatures to keep
138 in the pruning step. If you select a key using B<-u> it has to be in
139 this list. B<REQUIRED>.
141 =head2 General settings
143 =item B<caffhome> [string]
145 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
147 =head2 GnuPG settings
149 =item B<gpg> [string]
151 Path to the GnuPG binary. Default: B<gpg>.
153 =item B<gpg-sign> [string]
155 Path to the GnuPG binary which is used to sign keys. Default: what
158 =item B<gpg-delsig> [string]
160 Path to the GnuPG binary which is used to split off signatures. This was
161 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
164 =item B<secret-keyring> [string]
166 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
168 =item B<also-encrypt-to> [keyid, or list of keyids]
170 Additional keyids to encrypt messages to. Default: none.
172 =item B<gpg-sign-args> [string]
174 Additional commands to pass to gpg after the "sign" command.
177 =head2 Keyserver settings
179 =item B<keyserver> [string]
181 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
183 =item B<no-download> [boolean]
185 If true, then skip the step of fetching keys from the keyserver.
188 =item B<key-files> [list of files]
190 A list of files containing keys to be imported.
192 =head2 Signing settings
194 =item B<no-sign> [boolean]
196 If true, then skip the signing step. Default: B<0>.
198 =item B<ask-sign> [boolean]
200 If true, then pause before continuing to the signing step.
201 This is useful for offline signing. Default: B<0>.
203 =item B<export-sig-age> [seconds]
205 Don't export UIDs by default, on which your latest signature is older
206 than this age. Default: B<24*60*60> (i.e. one day).
208 =item B<local-user> [keyid, or list of keyids]
210 Select the key that is used for signing, in case you have more than one key.
211 With multiple keyids, sign with each key in turn.
215 =item B<mail> [boolean]
217 Do not prompt for sending mail, just do it. Default: B<0>.
219 =item B<no-mail> [boolean]
221 Do not prompt for sending mail. The messages are still written to
222 $CONFIG{'caffhome'}/keys/. Default: B<0>.
224 =item B<mail-template> [string]
226 Email template which is used as the body text for the email sent out
227 instead of the default text if specified. The following perl variables
228 can be used in the template:
232 =item B<{owner}> [string]
234 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
236 =item B<{key}> [string]
238 The keyid of the key you signed.
240 =item B<{@uids}> [array]
242 The UIDs for which signatures are included in the mail.
246 =item B<reply-to> [string]
248 Add a Reply-To: header to messages sent. Default: none.
250 =item B<bcc> [string]
252 Address to send blind carbon copies to when sending mail.
255 =item B<mailer-send> [array]
257 Parameters to pass to Mail::Mailer.
258 This could for example be
260 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
262 to use the perl SMTP client or
264 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
266 to pass arguments to the sendmail program.
267 For more information run C<< perldoc Mail::Mailer >>.
268 Setting this option is strongly discouraged. Fix your local MTA
278 =item Peter Palfrader <peter@palfrader.org>
280 =item Christoph Berg <cb@df7cb.de>
286 http://pgp-tools.alioth.debian.org/
290 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
298 use File
::Temp
qw{tempdir
};
305 use GnuPG
::Interface
;
308 my $REVISION = '$Rev$';
309 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
310 my $VERSION = "0.0.0.$REVISION_NUMER";
316 print "[WARN] $line\n";
320 print "[NOTICE] $line\n";
324 print "[INFO] $line\n";
328 #print "[DEBUG] $line\n";
332 #print "[trace] $line\n";
336 #print "[trace2] $line\n";
340 sub generate_config
() {
341 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
342 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
345 # BSD does not have hostname -f, so we try without -f first
346 my $hostname = `hostname`;
347 $hostname = `hostname -f` unless $hostname =~ /\./;
349 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
351 if (defined $gecos) {
354 my $gpg = GnuPG
::Interface
->new();
356 $gpg->options->hash_init(
357 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
358 $gpg->options->meta_interactive( 0 );
359 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
360 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
361 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
365 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
368 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
369 unless (scalar @keys) {
370 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
371 @keys = qw{0123456789abcdef
89abcdef76543210
};
374 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
375 unless (defined $email) {
376 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
377 $email = $ENV{'LOGNAME'}.'@'.$hostname;
381 $gecos = 'Unknown Caff User';
382 $email = $ENV{'LOGNAME'}.'@'.$hostname;
383 @keys = qw{0123456789abcdef
89abcdef76543210
};
384 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
387 my $template = <<EOT;
388 # .caffrc -- vim:ft=perl:
389 # This file is in perl(1) format - see caff(1) for details.
391 $Cgecos\$CONFIG{'owner'} = '$gecos';
392 $Cemail\$CONFIG{'email'} = '$email';
393 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
395 # You can get your long keyid from
396 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
398 # If you have a v4 key, it will simply be the last 16 digits of
402 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
403 # or, if you have more than one key:
404 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
405 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
407 # Select this/these keys to sign with
408 #\$CONFIG{'local-user'} = [ qw{@keys} ];
410 # Additionally encrypt messages for these keyids
411 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
413 # Mail template to use for the encrypted part
414 #\$CONFIG{'mail-template'} = << 'EOM';
417 $template .= "#$_" foreach <DATA
>;
418 $template .= "#EOM\n";
422 sub check_executable
($$) {
423 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
424 # so we want to check manually.)
425 my ($purpose, $fn) = @_;
426 # Only check provided fnames with a slash in them.
427 return unless defined $fn;
429 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
431 for my $p (split(':', $ENV{PATH
})) {
432 return if -x
"$p/$fn";
434 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
439 my $config = $ENV{'HOME'} . '/.caffrc';
440 unless (-f
$config) {
441 print "No configfile $config present, I will use this template:\n";
442 my $template = generate_config
();
443 print "$template\nPlease edit $config and run caff again.\n";
444 open F
, ">$config" or die "$config: $!";
449 unless (scalar eval `cat $config`) {
450 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
453 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
454 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
455 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
456 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
457 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
458 for my $keyid (@
{$CONFIG{'keyid'}}) {
459 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
461 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
462 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
463 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
464 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
465 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
466 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
467 check_executable
("gpg", $CONFIG{'gpg'});
468 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
469 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
470 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
471 unless defined $CONFIG{'secret-keyring'};
472 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
473 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
474 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
475 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
476 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
477 unless (defined $CONFIG{'mail-template'}) {
478 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
480 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
481 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
487 stdin
=> IO
::Handle
->new(),
488 stdout
=> IO
::Handle
->new(),
489 stderr
=> IO
::Handle
->new(),
490 status
=> IO
::Handle
->new() );
491 my $handles = GnuPG
::Handles
->new( %fds );
492 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
495 sub readwrite_gpg
($$$$$%) {
496 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
498 trace
("Entering readwrite_gpg.");
500 my ($first_line, undef) = split /\n/, $in;
501 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
503 local $INPUT_RECORD_SEPARATOR = undef;
504 my $sout = IO
::Select
->new();
505 my $sin = IO
::Select
->new();
508 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
510 $inputfd->blocking(0);
511 $stdoutfd->blocking(0);
512 $statusfd->blocking(0) if defined $statusfd;
513 $stderrfd->blocking(0);
514 $sout->add($stdoutfd);
515 $sout->add($stderrfd);
516 $sout->add($statusfd) if defined $statusfd;
519 my ($stdout, $stderr, $status) = ("", "", "");
520 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
521 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
523 my $readwrote_stuff_this_time = 0;
524 my $do_not_wait_on_select = 0;
525 my ($readyr, $readyw, $written);
526 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
527 if (defined $exitwhenstatusmatches) {
528 if ($status =~ /$exitwhenstatusmatches/m) {
529 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
530 if ($readwrote_stuff_this_time) {
531 trace
("read/write some more\n");
532 $do_not_wait_on_select = 1;
534 trace
("that's it in our while loop.\n");
540 $readwrote_stuff_this_time = 0;
541 trace
("select waiting for ".($sout->count())." fds.");
542 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
543 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
544 for my $wfd (@
$readyw) {
545 $readwrote_stuff_this_time = 1;
546 if (length($in) != $offset) {
547 trace
("writing to $wfd.");
548 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
551 if ($offset == length($in)) {
552 trace
("writing to $wfd done.");
553 unless ($options{'nocloseinput'}) {
555 trace
("$wfd closed.");
562 next unless (defined(@
$readyr)); # Wait some more.
564 for my $rfd (@
$readyr) {
565 $readwrote_stuff_this_time = 1;
567 trace
("reading from $rfd done.");
572 trace
("reading from $rfd.");
573 if ($rfd == $stdoutfd) {
575 trace2
("stdout is now $stdout\n================");
578 if (defined $statusfd && $rfd == $statusfd) {
580 trace2
("status is now $status\n================");
583 if ($rfd == $stderrfd) {
585 trace2
("stderr is now $stderr\n================");
590 trace
("readwrite_gpg done.");
591 return ($stdout, $stderr, $status);
595 my ($question, $default, $forceyes, $forceno) = @_;
597 my $yn = $default ?
'[Y/n]' : '[y/N]';
599 print $question,' ',$yn, ' ';
600 if ($forceyes && $forceno) {
601 print "$default (from config/command line)\n";
605 print "YES (from config/command line)\n";
609 print "NO (from config/command line)\n";
614 if (!defined $answer) {
615 $OUTPUT_AUTOFLUSH = 1;
617 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
618 "so you can't really use it with xargs. A patch against caff to read from\n".
619 "the terminal would be appreciated.\n".
620 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
623 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
624 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
627 my $result = $default;
628 $result = 1 if $answer =~ /y/i;
629 $result = 0 if $answer =~ /n/i;
637 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
638 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
639 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
640 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
641 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
644 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
646 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
647 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
649 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
650 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
653 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
654 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
659 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
663 my ($fd, $exitcode) = @_;
665 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
666 print $fd "Consult the manual page for more information.\n";
671 # export key $keyid from $gnupghome
674 my ($gnupghome, $keyid) = @_;
676 my $gpg = GnuPG
::Interface
->new();
677 $gpg->call( $CONFIG{'gpg'} );
678 if (defined $gnupghome) {
679 $gpg->options->hash_init(
680 'homedir' => $gnupghome,
681 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
684 $gpg->options->hash_init(
685 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
688 $gpg->options->meta_interactive( 0 );
689 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
690 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
691 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
698 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
701 my ($gnupghome, $asciikey) = @_;
703 my $gpg = GnuPG
::Interface
->new();
704 $gpg->call( $CONFIG{'gpg'} );
705 $gpg->options->hash_init(
706 'homedir' => $gnupghome,
707 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
708 $gpg->options->meta_interactive( 0 );
709 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
710 my $pid = $gpg->import_keys(handles
=> $handles);
711 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
714 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
722 # Send an email to $address. If $can_encrypt is true then the mail
723 # will be PGP/MIME encrypted to $longkeyid.
725 # $longkeyid, $uid, and @attached will be used in the email and the template.
727 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
728 sub send_mail
($$$@
) {
729 my ($address, $can_encrypt, $key_id, @keys) = @_;
731 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
732 or die "Error creating template: $Text::Template::ERROR";
735 for my $key (@keys) {
736 push @uids, $key->{'text'};
738 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
740 owner
=> $CONFIG{'owner'}})
741 or die "Error filling template in: $Text::Template::ERROR";
743 my $message_entity = MIME
::Entity
->build(
744 Type
=> "text/plain",
746 Disposition
=> 'inline',
750 for my $key (@keys) {
751 $message_entity->attach(
752 Type
=> "application/pgp-keys",
753 Disposition
=> 'attachment',
755 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
756 Data
=> $key->{'key'},
757 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
761 my $message = $message_entity->stringify();
763 my $gpg = GnuPG
::Interface
->new();
764 $gpg->call( $CONFIG{'gpg'} );
765 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
766 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
768 $gpg->options->meta_interactive( 0 );
769 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
770 $gpg->options->push_recipients( $key_id );
771 if (defined $CONFIG{'also-encrypt-to'}) {
772 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
774 my $pid = $gpg->encrypt(handles
=> $handles);
775 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
778 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
779 (defined $CONFIG{'also-encrypt-to'})) {
782 if (grep { %_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
783 warn("Could not encrypt to $keyid, spezified in CONFIG{'also-encrypt-to'}. Try to update the key using gpg --homedir=\$HOME/caff/gnupghome --import <keyd>.");
787 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
792 $message_entity = MIME
::Entity
->build(
793 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
796 $message_entity->attach(
797 Type
=> "application/pgp-encrypted",
798 Disposition
=> 'attachment',
800 Data
=> "Version: 1\n");
802 $message_entity->attach(
803 Type
=> "application/octet-stream",
804 Filename
=> 'msg.asc',
805 Disposition
=> 'inline',
810 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
811 $message_entity->head->add("To", $address);
812 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
813 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
814 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
815 $message_entity->head->add("User-Agent", $USER_AGENT);
816 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);
817 $message_entity->send(@
{$CONFIG{'mailer-send'}});
818 $message_entity->stringify();
822 # clean up a UID so that it can be used on the FS.
824 sub sanitize_uid
($) {
828 $good_uid =~ tr
#/:\\#_#;
829 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
833 sub delete_signatures
($$$$$$) {
834 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
836 my $signed_by_me = 0;
838 my ($stdout, $stderr, $status) =
839 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
841 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
842 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
843 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
844 $stdout =~ s/\n/\\n/g;
845 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
846 my $line = pop @sigline;
848 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
849 debug
("[sigremoval] doing line $line.");
850 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
851 if ($signer eq $longkeyid) {
852 debug
("[sigremoval] selfsig ($signer).");
854 } elsif (grep { $signer eq $_ } @
{$keyids}) {
855 debug
("[sigremoval] signed by us ($signer).");
857 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
859 debug
("[sigremoval] not interested in that sig ($signer).");
863 debug
("[sigremoval] no sig line here, only got: ".$stdout);
865 ($stdout, $stderr, $status) =
866 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
869 return $signed_by_me;
879 Getopt
::Long
::config
('bundling');
881 '-h' => \
$params->{'help'},
882 '--help' => \
$params->{'help'},
883 '--version' => \
$params->{'version'},
884 '-V' => \
$params->{'version'},
885 '-u=s' => \
$params->{'local-user'},
886 '--local-user=s' => \
$params->{'local-user'},
887 '-e' => \
$params->{'export-old'},
888 '--export-old' => \
$params->{'export-old'},
889 '-E' => \
$params->{'no-export-old'},
890 '--no-export-old' => \
$params->{'no-export-old'},
891 '-m' => \
$params->{'mail'},
892 '--mail' => \
$params->{'mail'},
893 '-M' => \
$params->{'no-mail'},
894 '--no-mail' => \
$params->{'no-mail'},
895 '-R' => \
$params->{'no-download'},
896 '--no-download' => \
$params->{'no-download'},
897 '-S' => \
$params->{'no-sign'},
898 '--no-sign' => \
$params->{'no-sign'},
899 '--key-file=s@' => \
$params->{'key-files'},
903 if ($params->{'help'}) {
906 if ($params->{'version'}) {
910 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
912 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
913 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
914 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
915 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
916 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
917 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
919 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
921 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
922 if ($keyid =~ /^[A-F0-9]{32}$/i) {
923 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
926 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
927 print STDERR
"$keyid is not a keyid.\n";
930 push @KEYIDS, uc($keyid);
936 for my $keyid (@
{$CONFIG{'keyid'}}) {
937 my $gpg = GnuPG
::Interface
->new();
938 $gpg->call( $CONFIG{'gpg'} );
939 $gpg->options->hash_init(
940 'homedir' => $GNUPGHOME,
941 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
942 $gpg->options->meta_interactive( 0 );
943 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
944 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
945 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
949 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
951 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
952 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
953 my $key = export_key
(undef, $keyid);
954 if (!defined $key || $key eq '') {
955 warn ("Did not get key $keyid from your normal GnuPGHome\n");
958 my $result = import_key
($GNUPGHOME, $key);
960 warn ("Could not import $keyid into caff's gnupghome.\n");
966 ########################
967 # import keys from files
968 ########################
969 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
970 my $gpg = GnuPG
::Interface
->new();
971 $gpg->call( $CONFIG{'gpg'} );
972 $gpg->options->hash_init('homedir' => $GNUPGHOME);
973 $gpg->options->meta_interactive( 0 );
974 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
975 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
976 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
977 info
("Importing keys from $keyfile");
979 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
984 #############################
985 # receive keys from keyserver
986 #############################
988 if ($CONFIG{'no-download'}) {
989 @keyids_ok = @KEYIDS;
991 info
("fetching keys, this will take a while...");
993 my $gpg = GnuPG
::Interface
->new();
994 $gpg->call( $CONFIG{'gpg'} );
995 $gpg->options->hash_init(
996 'homedir' => $GNUPGHOME,
997 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
998 $gpg->options->meta_interactive( 0 );
999 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1000 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1001 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1004 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1007 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1008 my %local_keyids = map { $_ => 1 } @KEYIDS;
1009 my $had_v3_keys = 0;
1010 for my $line (split /\n/, $status) {
1011 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1012 my $imported_key = $1;
1013 my $whole_fpr = $imported_key;
1014 my $long_keyid = substr($imported_key, -16);
1015 my $short_keyid = substr($imported_key, -8);
1017 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1018 $speced_key = $spec if $local_keyids{$spec};
1020 unless ($speced_key) {
1021 notice
("Imported unexpected key; got: $imported_key\n");
1024 debug
("Imported $imported_key for $speced_key");
1025 delete $local_keyids{$speced_key};
1026 unshift @keyids_ok, $imported_key;
1027 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1028 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1029 my $imported_key = $1;
1030 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.");
1033 notice
("got unknown reply from gpg: $line");
1036 if (scalar %local_keyids) {
1037 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1038 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1039 if (scalar keys %local_keyids == 1) {
1040 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1042 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1044 push @keyids_ok, keys %local_keyids;
1048 unless (@keyids_ok) {
1049 notice
("No keys to sign found");
1056 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1057 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1060 unless ($CONFIG{'no-sign'}) {
1062 if ($CONFIG{'local-user'}) {
1063 if (ref($CONFIG{'local-user'})) {
1064 @local_user = @
{$CONFIG{'local-user'}};
1066 @local_user = split /\s*,\s*/, $CONFIG{'local-user'};
1068 foreach (@local_user) {
1070 unless (/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1071 print STDERR
"Local-user $_ is not a keyid.\n";
1077 @local_user = (undef);
1080 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1081 for my $keyid (@keyids_ok) {
1082 foreach my $local_user (@local_user) {
1084 push @command, $CONFIG{'gpg-sign'};
1085 push @command, '--local-user', $local_user if (defined $local_user);
1086 push @command, "--homedir=$GNUPGHOME";
1087 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1088 push @command, '--no-auto-check-trustdb';
1089 push @command, '--trust-model=always';
1090 push @command, '--edit', $keyid;
1091 push @command, 'sign';
1092 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1093 print join(' ', @command),"\n";
1103 for my $keyid (@keyids_ok) {
1106 my $gpg = GnuPG
::Interface
->new();
1107 $gpg->call( $CONFIG{'gpg'} );
1108 $gpg->options->hash_init(
1109 'homedir' => $GNUPGHOME,
1110 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1111 $gpg->options->meta_interactive( 0 );
1112 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1113 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1114 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1116 if ($stdout eq '') {
1117 warn ("No data from gpg for list-key $keyid\n");
1120 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1121 if (scalar @publine == 0) {
1122 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1125 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1126 if (scalar @publine > 0) {
1127 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1130 unless (defined $longkeyid) {
1131 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1134 unless (defined $flags) {
1135 warn ("Didn't find flags in --list-key of key $keyid.\n");
1138 my $can_encrypt = $flags =~ /E/;
1142 my $asciikey = export_key
($GNUPGHOME, $keyid);
1143 if ($asciikey eq '') {
1144 warn ("No data from gpg for export $keyid\n");
1151 my $this_uid_text = '';
1153 debug
("Doing key $keyid, uid $uid_number");
1154 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1156 # import into temporary gpghome
1157 ###############################
1158 my $result = import_key
($tempdir, $asciikey);
1160 warn ("Could not import $keyid into temporary gnupg.\n");
1166 $gpg = GnuPG
::Interface
->new();
1167 $gpg->call( $CONFIG{'gpg-delsig'} );
1168 $gpg->options->hash_init(
1169 'homedir' => $tempdir,
1170 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1171 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1172 $pid = $gpg->wrap_call(
1173 commands
=> [ '--edit' ],
1174 command_args
=> [ $keyid ],
1175 handles
=> $handles );
1177 debug
("Starting edit session");
1178 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1182 my $number_of_subkeys = 0;
1186 my $delete_some = 0;
1187 debug
("Parsing stdout output.");
1188 for my $line (split /\n/, $stdout) {
1189 debug
("Checking line $line");
1190 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1191 if ($type eq 'sub') {
1192 $number_of_subkeys++;
1194 next unless ($type eq 'uid' || $type eq 'uat');
1195 debug
("line is interesting.");
1196 if ($uid_number != $i) {
1197 debug
("mark for deletion.");
1198 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1203 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1204 $is_uat = $type eq 'uat';
1208 debug
("Parsing stdout output done.");
1209 unless ($have_one) {
1210 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1211 info
("key $keyid done.");
1215 my $prune_some_sigs_on_uid;
1216 my $prune_all_sigs_on_uid;
1218 debug
("handling attribute userid of key $keyid.");
1219 if ($uid_number == 1) {
1220 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1221 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1223 $prune_some_sigs_on_uid = 1;
1224 $prune_all_sigs_on_uid = 2;
1226 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1227 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1229 $prune_some_sigs_on_uid = 2;
1230 $prune_all_sigs_on_uid = 1;
1233 $prune_some_sigs_on_uid = 1;
1237 debug
("need to delete $delete_some uids.");
1238 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1239 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1244 if ($number_of_subkeys > 0) {
1245 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1246 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1248 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1249 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1254 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1255 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1256 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1257 if (defined $prune_all_sigs_on_uid) {
1258 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1259 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1260 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1264 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1267 my $asciikey = export_key
($tempdir, $keyid);
1268 if ($asciikey eq '') {
1269 warn ("No data from gpg for export $keyid\n");
1273 if ($signed_by_me) {
1274 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1275 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1278 my $keydir = "$KEYSBASE/$DATE_STRING";
1279 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1281 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1282 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1283 print KEY
$asciikey;
1286 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1288 info
("$longkeyid $uid_number $this_uid_text done.");
1290 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1294 if (scalar @UIDS == 0) {
1295 info
("found no signed uids for $keyid");
1297 next if $CONFIG{'no-mail'}; # do not send mail
1300 for my $uid (@UIDS) {
1301 trace
("UID: $uid->{'text'}\n");
1302 if ($uid->{'is_uat'}) {
1303 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1304 push @attached, $uid if $attach;
1305 } elsif ($uid->{'text'} !~ /@/) {
1306 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1307 push @attached, $uid if $attach;
1311 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1312 for my $uid (@UIDS) {
1313 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1314 my $address = $uid->{'text'};
1315 $address =~ s/.*<(.*)>.*/$1/;
1316 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1317 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1319 my $keydir = "$KEYSBASE/$DATE_STRING";
1320 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1321 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1331 ###########################
1332 # the default mail template
1333 ###########################
1338 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1339 {foreach $uid (@uids) {
1340 $OUT .= "\t".$uid."\n";
1341 };}of your key
{$key} signed by me
.
1343 If you have multiple user ids
, I sent the signature
for each user id
1344 separately to that user id
's associated email address. You can import
1345 the signatures by running each through `gpg --import`.
1347 Note that I did not upload your key to any keyservers. If you want this
1348 new signature to be available to others, please upload it yourself.
1349 With GnuPG this can be done using
1350 gpg --keyserver subkeys.pgp.net --send-key {$key}
1352 If you have any questions, don't hesitate to ask
.