3 # caff -- CA - Fire and Forget
6 # Copyright (c) 2004, 2005, 2006 Peter Palfrader <peter@palfrader.org>
7 # Copyright (c) 2005, 2006 Christoph Berg <cb@df7cb.de>
11 # Redistribution and use in source and binary forms, with or without
12 # modification, are permitted provided that the following conditions
14 # 1. Redistributions of source code must retain the above copyright
15 # notice, this list of conditions and the following disclaimer.
16 # 2. Redistributions in binary form must reproduce the above copyright
17 # notice, this list of conditions and the following disclaimer in the
18 # documentation and/or other materials provided with the distribution.
19 # 3. The name of the author may not be used to endorse or promote products
20 # derived from this software without specific prior written permission.
22 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
23 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
24 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
25 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
27 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
31 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 caff -- CA - Fire and Forget
43 =item B<caff> [-eERS] [-m I<yes|ask-yes|ask-no|no>] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
49 CA Fire and Forget is a script that helps you in keysigning. It takes a list
50 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
51 that you can sign it. It then mails each key to all its email addresses - only
52 including the one UID that we send to in each mail, pruned from all but self
53 sigs and sigs done by you. The mailed key is encrypted with itself as a means
54 to verify that key belongs to the recipient.
60 =item B<-e>, B<--export-old>
62 Export old signatures. Default is to ask the user for each old signature.
64 =item B<-E>, B<--no-export-old>
66 Do not export old signatures. Default is to ask the user for each old
69 =item B<-m>, B<--mail> I<yes|ask-yes|ask-no|no>
71 Whether to send mail after signing. Default is to ask, for each uid,
72 with a default value of yes.
74 =item B<-R>, B<--no-download>
76 Do not retrieve the key to be signed from a keyserver.
78 =item B<-S>, B<--no-sign>
82 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
84 Select the key that is used for signing, in case you have more than one key.
85 To sign with multiple keys at once, separate multiple keyids by comma. This
86 option requires the key(s) to be defined through the keyid variable in the
89 =item B<--key-file> I<file>
91 Import keys from file. Can be supplied more than once.
99 =item $HOME/.caffrc - configuration file
101 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
103 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
105 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
107 useful options include use-agent, keyserver-options, default-cert-level, etc.
111 =head1 CONFIGURATION FILE OPTIONS
113 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
114 The file is generated when it does not exist.
118 $CONFIG{'owner'} = q{Peter Palfrader};
119 $CONFIG{'email'} = q{peter@palfrader.org};
120 $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
122 =head2 Required basic settings
126 =item B<owner> [string]
128 Your name. B<REQUIRED>.
130 =item B<email> [string]
132 Your email address, used in From: lines. B<REQUIRED>.
134 =item B<keyid> [list of keyids]
136 A list of your keys. This is used to determine which signatures to keep
137 in the pruning step. If you select a key using B<-u> it has to be in
138 this list. B<REQUIRED>.
142 =head2 General settings
146 =item B<caffhome> [string]
148 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
152 =head2 GnuPG settings
156 =item B<gpg> [string]
158 Path to the GnuPG binary. Default: B<gpg>.
160 =item B<gpg-sign> [string]
162 Path to the GnuPG binary which is used to sign keys. Default: what
165 =item B<gpg-delsig> [string]
167 Path to the GnuPG binary which is used to split off signatures. This was
168 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
171 =item B<secret-keyring> [string]
173 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
175 =item B<also-encrypt-to> [keyid, or list of keyids]
177 Additional keyids to encrypt messages to. Default: none.
179 =item B<gpg-sign-args> [string]
181 Additional commands to pass to gpg after the "sign" command.
186 =head2 Keyserver settings
190 =item B<keyserver> [string]
192 Keyserver to download keys from. Default: B<pool.sks-keyservers.net>.
194 =item B<no-download> [boolean]
196 If true, then skip the step of fetching keys from the keyserver.
199 =item B<key-files> [list of files]
201 A list of files containing keys to be imported.
205 =head2 Signing settings
209 =item B<no-sign> [boolean]
211 If true, then skip the signing step. Default: B<0>.
213 =item B<ask-sign> [boolean]
215 If true, then pause before continuing to the signing step.
216 This is useful for offline signing. Default: B<0>.
218 =item B<export-sig-age> [seconds]
220 Don't export UIDs by default, on which your latest signature is older
221 than this age. Default: B<24*60*60> (i.e. one day).
223 =item B<local-user> [keyid, or list of keyids]
225 Select the key that is used for signing, in case you have more than one key.
226 With multiple keyids, sign with each key in turn.
234 =item B<mail> [boolean]
236 Whether to send mails. This is a quad-option, with which you can set the
237 behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
238 each uid, with according defaults for the question. Default: B<ask-yes>.
240 In any case, the messages are also written to $CONFIG{'caffhome'}/keys/
242 =item B<mail-template> [string]
244 Email template which is used as the body text for the email sent out
245 instead of the default text if specified. The following perl variables
246 can be used in the template:
250 =item B<{owner}> [string]
252 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
254 =item B<{key}> [string]
256 The keyid of the key you signed.
258 =item B<{@uids}> [array]
260 The UIDs for which signatures are included in the mail.
264 =item B<reply-to> [string]
266 Add a Reply-To: header to messages sent. Default: none.
268 =item B<bcc> [string]
270 Address to send blind carbon copies to when sending mail.
273 =item B<mailer-send> [array]
275 Parameters to pass to Mail::Mailer.
276 This could for example be
278 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
280 to use the perl SMTP client or
282 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
284 to pass arguments to the sendmail program.
285 For more information run C<< perldoc Mail::Mailer >>.
286 Setting this option is strongly discouraged. Fix your local MTA
296 =item Peter Palfrader <peter@palfrader.org>
298 =item Christoph Berg <cb@df7cb.de>
304 http://pgp-tools.alioth.debian.org/
308 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
316 use File
::Temp
qw{tempdir
};
323 use GnuPG
::Interface
;
326 my $REVISION = '$Rev$';
327 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
328 my $VERSION = "0.0.0.$REVISION_NUMER";
332 # Display an error message on STDERR and then exit.
334 # @param $exitcode exit code status to use to end the program
335 # @param $line error message to display on STDERR
338 my ($exitcode, $line) = @_;
339 print "[ERROR] $line\n";
345 print "[WARN] $line\n";
349 print "[NOTICE] $line\n";
353 print "[INFO] $line\n";
357 #print "[DEBUG] $line\n";
361 #print "[trace] $line\n";
365 #print "[trace2] $line\n";
369 sub generate_config
() {
370 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
371 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
374 # BSD does not have hostname -f, so we try without -f first
375 my $hostname = `hostname`;
376 $hostname = `hostname -f` unless $hostname =~ /\./;
378 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
380 if (defined $gecos) {
383 my $gpg = GnuPG
::Interface
->new();
385 $gpg->options->hash_init(
386 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
387 $gpg->options->meta_interactive( 0 );
388 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
389 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
390 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
394 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
397 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
398 unless (scalar @keys) {
399 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
400 @keys = qw{0123456789abcdef
89abcdef76543210
};
403 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
404 unless (defined $email) {
405 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
406 $email = $ENV{'LOGNAME'}.'@'.$hostname;
410 $gecos = 'Unknown Caff User';
411 $email = $ENV{'LOGNAME'}.'@'.$hostname;
412 @keys = qw{0123456789abcdef
89abcdef76543210
};
413 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
416 my $template = <<EOT;
417 # .caffrc -- vim:ft=perl:
418 # This file is in perl(1) format - see caff(1) for details.
420 $Cgecos\$CONFIG{'owner'} = '$gecos';
421 $Cemail\$CONFIG{'email'} = '$email';
422 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
424 # You can get your long keyid from
425 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
427 # If you have a v4 key, it will simply be the last 16 digits of
431 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
432 # or, if you have more than one key:
433 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
434 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
436 # Select this/these keys to sign with
437 #\$CONFIG{'local-user'} = [ qw{@keys} ];
439 # Additionally encrypt messages for these keyids
440 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
442 # Mail template to use for the encrypted part
443 #\$CONFIG{'mail-template'} = << 'EOM';
446 $template .= "#$_" foreach <DATA
>;
447 $template .= "#EOM\n";
451 sub check_executable
($$) {
452 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
453 # so we want to check manually.)
454 my ($purpose, $fn) = @_;
455 # Only check provided fnames with a slash in them.
456 return unless defined $fn;
458 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
460 for my $p (split(':', $ENV{PATH
})) {
461 return if -x
"$p/$fn";
463 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
468 my $config = $ENV{'HOME'} . '/.caffrc';
469 unless (-f
$config) {
470 print "No configfile $config present, I will use this template:\n";
471 my $template = generate_config
();
472 print "$template\nPlease edit $config and run caff again.\n";
473 open F
, ">$config" or die "$config: $!";
478 unless (scalar eval `cat $config`) {
479 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
482 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
483 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
484 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
485 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
486 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
487 for my $keyid (@
{$CONFIG{'keyid'}}) {
488 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
490 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
491 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
492 $CONFIG{'keyserver'} = 'pool.sks-keyservers.net' unless defined $CONFIG{'keyserver'};
493 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
494 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
495 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
496 check_executable
("gpg", $CONFIG{'gpg'});
497 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
498 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
499 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
500 unless defined $CONFIG{'secret-keyring'};
501 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
502 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
503 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
504 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
505 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
506 unless (defined $CONFIG{'mail-template'}) {
507 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
509 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
510 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
516 stdin
=> IO
::Handle
->new(),
517 stdout
=> IO
::Handle
->new(),
518 stderr
=> IO
::Handle
->new(),
519 status
=> IO
::Handle
->new() );
520 my $handles = GnuPG
::Handles
->new( %fds );
521 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
524 sub readwrite_gpg
($$$$$%) {
525 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
527 trace
("Entering readwrite_gpg.");
529 my ($first_line, undef) = split /\n/, $in;
530 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
532 local $INPUT_RECORD_SEPARATOR = undef;
533 my $sout = IO
::Select
->new();
534 my $sin = IO
::Select
->new();
537 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
539 $inputfd->blocking(0);
540 $stdoutfd->blocking(0);
541 $statusfd->blocking(0) if defined $statusfd;
542 $stderrfd->blocking(0);
543 $sout->add($stdoutfd);
544 $sout->add($stderrfd);
545 $sout->add($statusfd) if defined $statusfd;
548 my ($stdout, $stderr, $status) = ("", "", "");
549 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
550 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
552 my $readwrote_stuff_this_time = 0;
553 my $do_not_wait_on_select = 0;
554 my ($readyr, $readyw, $written);
555 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
556 if (defined $exitwhenstatusmatches) {
557 if ($status =~ /$exitwhenstatusmatches/m) {
558 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
559 if ($readwrote_stuff_this_time) {
560 trace
("read/write some more\n");
561 $do_not_wait_on_select = 1;
563 trace
("that's it in our while loop.\n");
569 $readwrote_stuff_this_time = 0;
570 trace
("select waiting for ".($sout->count())." fds.");
571 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
572 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
573 for my $wfd (@
$readyw) {
574 $readwrote_stuff_this_time = 1;
575 if (length($in) != $offset) {
576 trace
("writing to $wfd.");
577 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
580 if ($offset == length($in)) {
581 trace
("writing to $wfd done.");
582 unless ($options{'nocloseinput'}) {
584 trace
("$wfd closed.");
591 next unless (defined(@
$readyr)); # Wait some more.
593 for my $rfd (@
$readyr) {
594 $readwrote_stuff_this_time = 1;
596 trace
("reading from $rfd done.");
601 trace
("reading from $rfd.");
602 if ($rfd == $stdoutfd) {
604 trace2
("stdout is now $stdout\n================");
607 if (defined $statusfd && $rfd == $statusfd) {
609 trace2
("status is now $status\n================");
612 if ($rfd == $stderrfd) {
614 trace2
("stderr is now $stderr\n================");
619 trace
("readwrite_gpg done.");
620 return ($stdout, $stderr, $status);
624 my ($question, $default, $forceyes, $forceno) = @_;
626 my $yn = $default ?
'[Y/n]' : '[y/N]';
628 print $question,' ',$yn, ' ';
629 if ($forceyes && $forceno) {
630 print "$default (from config/command line)\n";
634 print "YES (from config/command line)\n";
638 print "NO (from config/command line)\n";
643 if (!defined $answer) {
644 $OUTPUT_AUTOFLUSH = 1;
646 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
647 "so you can't really use it with xargs. A patch against caff to read from\n".
648 "the terminal would be appreciated.\n".
649 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
652 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
653 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
656 my $result = $default;
657 $result = 1 if $answer =~ /y/i;
658 $result = 0 if $answer =~ /n/i;
666 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
667 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
668 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
669 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
670 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
673 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
675 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
676 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
678 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
679 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
682 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
683 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
688 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
692 my ($fd, $exitcode) = @_;
694 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
695 print $fd "Consult the manual page for more information.\n";
700 # export key $keyid from $gnupghome
703 my ($gnupghome, $keyid) = @_;
705 my $gpg = GnuPG
::Interface
->new();
706 $gpg->call( $CONFIG{'gpg'} );
707 if (defined $gnupghome) {
708 $gpg->options->hash_init(
709 'homedir' => $gnupghome,
710 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
713 $gpg->options->hash_init(
714 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
717 $gpg->options->meta_interactive( 0 );
718 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
719 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
720 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
727 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
730 my ($gnupghome, $asciikey) = @_;
732 my $gpg = GnuPG
::Interface
->new();
733 $gpg->call( $CONFIG{'gpg'} );
734 $gpg->options->hash_init(
735 'homedir' => $gnupghome,
736 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
737 $gpg->options->meta_interactive( 0 );
738 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
739 my $pid = $gpg->import_keys(handles
=> $handles);
740 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
743 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
751 # Send an email to $address. If $can_encrypt is true then the mail
752 # will be PGP/MIME encrypted to $longkeyid.
754 # $longkeyid, $uid, and @attached will be used in the email and the template.
756 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
757 sub send_mail
($$$@
) {
758 my ($address, $can_encrypt, $key_id, @keys) = @_;
760 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
761 or die "Error creating template: $Text::Template::ERROR";
764 for my $key (@keys) {
765 push @uids, $key->{'text'};
767 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
769 owner
=> $CONFIG{'owner'}})
770 or die "Error filling template in: $Text::Template::ERROR";
772 my $message_entity = MIME
::Entity
->build(
773 Type
=> "text/plain",
775 Disposition
=> 'inline',
779 for my $key (@keys) {
780 $message_entity->attach(
781 Type
=> "application/pgp-keys",
782 Disposition
=> 'attachment',
784 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
785 Data
=> $key->{'key'},
786 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
790 my $message = $message_entity->stringify();
792 my $gpg = GnuPG
::Interface
->new();
793 $gpg->call( $CONFIG{'gpg'} );
794 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
795 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
797 $gpg->options->meta_interactive( 0 );
798 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
799 $gpg->options->push_recipients( $key_id );
800 if (defined $CONFIG{'also-encrypt-to'}) {
801 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
803 my $pid = $gpg->encrypt(handles
=> $handles);
804 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
807 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
808 (defined $CONFIG{'also-encrypt-to'})) {
811 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
812 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
813 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
814 "or try the following if you are slightly more daring:\n".
815 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
819 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
824 $message_entity = MIME
::Entity
->build(
825 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
828 $message_entity->attach(
829 Type
=> "application/pgp-encrypted",
830 Filename
=> "signedkey.msg",
831 Disposition
=> 'attachment',
833 Data
=> "Version: 1\n");
835 $message_entity->attach(
836 Type
=> "application/octet-stream",
837 Filename
=> 'msg.asc',
838 Disposition
=> 'inline',
843 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
844 $message_entity->head->add("To", $address);
845 $message_entity->head->add("From", '"'.Encode
::encode
('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>');
846 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
847 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
848 $message_entity->head->add("User-Agent", $USER_AGENT);
849 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);
850 $message_entity->send(@
{$CONFIG{'mailer-send'}});
851 $message_entity->stringify();
855 # clean up a UID so that it can be used on the FS.
857 sub sanitize_uid
($) {
861 $good_uid =~ tr
#/:\\#_#;
862 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
866 sub delete_signatures
($$$$$$) {
867 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
869 my $signed_by_me = 0;
871 my ($stdout, $stderr, $status) =
872 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
874 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
875 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
876 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
877 $stdout =~ s/\n/\\n/g;
878 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
879 my $line = pop @sigline;
881 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
882 debug
("[sigremoval] doing line $line.");
883 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
884 if ($signer eq $longkeyid) {
885 debug
("[sigremoval] selfsig ($signer).");
887 } elsif (grep { $signer eq $_ } @
{$keyids}) {
888 debug
("[sigremoval] signed by us ($signer).");
890 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
892 debug
("[sigremoval] not interested in that sig ($signer).");
896 debug
("[sigremoval] no sig line here, only got: ".$stdout);
898 ($stdout, $stderr, $status) =
899 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
902 return $signed_by_me;
906 # Check the local user keys.
908 # This function checks if the keyids defined through the --local-user
909 # command line option or set in .caffrc are valid and known to be one of the
910 # keyids listed in ./caffrc. The last check ensure we have those keyids
911 # available in the caff's gnupghome directory.
913 # @return an array containing the local user keys\n
914 # (undef) if no key has been specified
916 sub get_local_user_keys
()
921 # No user-defined key id has been specified by the user, no need for
923 if (!$CONFIG{'local-user'}) {
927 # Parse the list of keys
928 if (ref($CONFIG{'local-user'})) {
929 @key_list = @
{$CONFIG{'local-user'}};
932 @key_list = split /\s*,\s*/, $CONFIG{'local-user'};
935 # Check every key defined by the user...
936 for my $user_key (@key_list) {
938 $user_key =~ s/^0x//i;
939 $user_key = uc($user_key);
941 unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) {
942 mywarn
"Local-user $user_key is not a valid keyid.";
946 unless (grep (/$user_key$/, @
{$CONFIG{'keyid'}})) {
947 mywarn
"Local-user $user_key is not defined as one of your keyid in ./caffrc (it will not be used).";
951 push (@local_user, $user_key);
954 # If no local-user key are valid, there is no need to go further
955 unless (defined $local_user[0]) {
956 myerror
(1, "None of the local-user keys seem to be known as a keyid listed in ./caffrc.");
969 Getopt
::Long
::config
('bundling');
971 '-h' => \
$params->{'help'},
972 '--help' => \
$params->{'help'},
973 '--version' => \
$params->{'version'},
974 '-V' => \
$params->{'version'},
975 '-u=s' => \
$params->{'local-user'},
976 '--local-user=s' => \
$params->{'local-user'},
977 '-e' => \
$params->{'export-old'},
978 '--export-old' => \
$params->{'export-old'},
979 '-E' => \
$params->{'no-export-old'},
980 '--no-export-old' => \
$params->{'no-export-old'},
981 '-m:s' => \
$params->{'mail'},
982 '--mail:s' => \
$params->{'mail'},
983 '-M' => \
$params->{'no-mail'},
984 '--no-mail' => \
$params->{'no-mail'},
985 '-R' => \
$params->{'no-download'},
986 '--no-download' => \
$params->{'no-download'},
987 '-S' => \
$params->{'no-sign'},
988 '--no-sign' => \
$params->{'no-sign'},
989 '--key-file=s@' => \
$params->{'key-files'},
993 if ($params->{'help'}) {
996 if ($params->{'version'}) {
1000 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
1002 $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'};
1003 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
1004 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
1006 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
1007 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
1009 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
1010 if ( defined $CONFIG{'no-mail'} ||
1011 ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) {
1012 $CONFIG{'mail'} = 'no';
1014 } elsif ( !defined $CONFIG{'mail'} ) {
1015 $CONFIG{'mail'} = 'ask-yes';
1018 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
1020 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
1022 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
1023 if ($keyid =~ /^[A-F0-9]{32}$/i) {
1024 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
1027 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1028 print STDERR
"$keyid is not a keyid.\n";
1031 push @KEYIDS, uc($keyid);
1037 for my $keyid (@
{$CONFIG{'keyid'}}) {
1038 info
("Importing key $keyid from your normal GnuPGHome.");
1039 my $key = export_key
(undef, $keyid);
1040 if (!defined $key || $key eq '') {
1041 warn ("Did not get key $keyid from your normal GnuPGHome\n");
1044 my $result = import_key
($GNUPGHOME, $key);
1046 warn ("Could not import $keyid into caff's gnupghome.\n");
1051 ########################
1052 # import keys from files
1053 ########################
1054 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
1055 my $gpg = GnuPG
::Interface
->new();
1056 $gpg->call( $CONFIG{'gpg'} );
1057 $gpg->options->hash_init('homedir' => $GNUPGHOME);
1058 $gpg->options->meta_interactive( 0 );
1059 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1060 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
1061 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1062 info
("Importing keys from $keyfile");
1064 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
1069 #############################
1070 # receive keys from keyserver
1071 #############################
1073 if ($CONFIG{'no-download'}) {
1074 @keyids_ok = @KEYIDS;
1076 info
("fetching keys, this will take a while...");
1078 my $gpg = GnuPG
::Interface
->new();
1079 $gpg->call( $CONFIG{'gpg'} );
1080 $gpg->options->hash_init(
1081 'homedir' => $GNUPGHOME,
1082 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1083 $gpg->options->meta_interactive( 0 );
1084 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1085 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1086 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1089 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1092 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1093 my %local_keyids = map { $_ => 1 } @KEYIDS;
1094 my $had_v3_keys = 0;
1095 for my $line (split /\n/, $status) {
1096 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1097 my $imported_key = $1;
1098 my $whole_fpr = $imported_key;
1099 my $long_keyid = substr($imported_key, -16);
1100 my $short_keyid = substr($imported_key, -8);
1102 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1103 $speced_key = $spec if $local_keyids{$spec};
1105 unless ($speced_key) {
1106 notice
("Imported unexpected key; got: $imported_key\n");
1109 debug
("Imported $imported_key for $speced_key");
1110 delete $local_keyids{$speced_key};
1111 unshift @keyids_ok, $imported_key;
1112 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1113 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1114 my $imported_key = $1;
1115 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.");
1118 notice
("got unknown reply from gpg: $line");
1121 if (scalar %local_keyids) {
1122 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1123 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1124 if (scalar keys %local_keyids == 1) {
1125 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1127 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1129 push @keyids_ok, keys %local_keyids;
1133 unless (@keyids_ok) {
1134 notice
("No keys to sign found");
1141 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1142 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1145 unless ($CONFIG{'no-sign'})
1147 my @local_user = &get_local_user_keys
();
1149 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1150 for my $keyid (@keyids_ok) {
1151 foreach my $local_user (@local_user) {
1153 push @command, $CONFIG{'gpg-sign'};
1154 push @command, '--local-user', $local_user if (defined $local_user);
1155 push @command, "--homedir=$GNUPGHOME";
1156 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1157 push @command, '--no-auto-check-trustdb';
1158 push @command, '--trust-model=always';
1159 push @command, '--edit', $keyid;
1160 push @command, 'sign';
1161 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1162 print join(' ', @command),"\n";
1172 for my $keyid (@keyids_ok) {
1175 my $gpg = GnuPG
::Interface
->new();
1176 $gpg->call( $CONFIG{'gpg'} );
1177 $gpg->options->hash_init(
1178 'homedir' => $GNUPGHOME,
1179 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1180 $gpg->options->meta_interactive( 0 );
1181 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1182 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1183 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1185 if ($stdout eq '') {
1186 warn ("No data from gpg for list-key $keyid\n");
1189 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1190 if (scalar @publine == 0) {
1191 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1194 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1195 if (scalar @publine > 0) {
1196 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1199 unless (defined $longkeyid) {
1200 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1203 unless (defined $flags) {
1204 warn ("Didn't find flags in --list-key of key $keyid.\n");
1207 my $can_encrypt = $flags =~ /E/;
1211 my $asciikey = export_key
($GNUPGHOME, $keyid);
1212 if ($asciikey eq '') {
1213 warn ("No data from gpg for export $keyid\n");
1220 my $this_uid_text = '';
1222 debug
("Doing key $keyid, uid $uid_number");
1223 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1225 # import into temporary gpghome
1226 ###############################
1227 my $result = import_key
($tempdir, $asciikey);
1229 warn ("Could not import $keyid into temporary gnupg.\n");
1235 $gpg = GnuPG
::Interface
->new();
1236 $gpg->call( $CONFIG{'gpg-delsig'} );
1237 $gpg->options->hash_init(
1238 'homedir' => $tempdir,
1239 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1240 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1241 $pid = $gpg->wrap_call(
1242 commands
=> [ '--edit' ],
1243 command_args
=> [ $keyid ],
1244 handles
=> $handles );
1246 debug
("Starting edit session");
1247 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1251 my $number_of_subkeys = 0;
1255 my $delete_some = 0;
1256 debug
("Parsing stdout output.");
1257 for my $line (split /\n/, $stdout) {
1258 debug
("Checking line $line");
1259 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1260 if ($type eq 'sub') {
1261 $number_of_subkeys++;
1263 next unless ($type eq 'uid' || $type eq 'uat');
1264 debug
("line is interesting.");
1265 if ($uid_number != $i) {
1266 debug
("mark for deletion.");
1267 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1272 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1273 $is_uat = $type eq 'uat';
1277 debug
("Parsing stdout output done.");
1278 unless ($have_one) {
1279 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1280 info
("key $keyid done.");
1284 my $prune_some_sigs_on_uid;
1285 my $prune_all_sigs_on_uid;
1287 debug
("handling attribute userid of key $keyid.");
1288 if ($uid_number == 1) {
1289 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1290 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1292 $prune_some_sigs_on_uid = 1;
1293 $prune_all_sigs_on_uid = 2;
1295 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1296 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1298 $prune_some_sigs_on_uid = 2;
1299 $prune_all_sigs_on_uid = 1;
1302 $prune_some_sigs_on_uid = 1;
1306 debug
("need to delete $delete_some uids.");
1307 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1308 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1313 if ($number_of_subkeys > 0) {
1314 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1315 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1317 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1318 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1323 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1324 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1325 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1326 if (defined $prune_all_sigs_on_uid) {
1327 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1328 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1329 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1333 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1336 my $asciikey = export_key
($tempdir, $keyid);
1337 if ($asciikey eq '') {
1338 warn ("No data from gpg for export $keyid\n");
1342 if ($signed_by_me) {
1343 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1344 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1347 my $keydir = "$KEYSBASE/$DATE_STRING";
1348 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1350 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1351 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1352 print KEY
$asciikey;
1355 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1357 info
("$longkeyid $uid_number $this_uid_text done.");
1359 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1363 if (scalar @UIDS == 0) {
1364 info
("found no signed uids for $keyid");
1366 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1369 for my $uid (@UIDS) {
1370 trace
("UID: $uid->{'text'}\n");
1371 if ($uid->{'is_uat'}) {
1372 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1373 push @attached, $uid if $attach;
1374 } elsif ($uid->{'text'} !~ /@/) {
1375 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1376 push @attached, $uid if $attach;
1380 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1381 for my $uid (@UIDS) {
1382 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1383 my $address = $uid->{'text'};
1384 $address =~ s/.*<(.*)>.*/$1/;
1385 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1386 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1387 if (defined $mail) {
1388 my $keydir = "$KEYSBASE/$DATE_STRING";
1389 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1390 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1394 warn "Generating mail failed.\n";
1403 ###########################
1404 # the default mail template
1405 ###########################
1410 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1411 {foreach $uid (@uids) {
1412 $OUT .= "\t".$uid."\n";
1413 };}of your key
{$key} signed by me
.
1415 If you have multiple user ids
, I sent the signature
for each user id
1416 separately to that user id
's associated email address. You can import
1417 the signatures by running each through `gpg --import`.
1419 Note that I did not upload your key to any keyservers. If you want this
1420 new signature to be available to others, please upload it yourself.
1421 With GnuPG this can be done using
1422 gpg --keyserver pool.sks-keyservers.net --send-key {$key}
1424 If you have any questions, don't hesitate to ask
.