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>.
138 =head2 General settings
140 =item B<caffhome> [string]
142 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
144 =head2 GnuPG settings
146 =item B<gpg> [string]
148 Path to the GnuPG binary. Default: B<gpg>.
150 =item B<gpg-sign> [string]
152 Path to the GnuPG binary which is used to sign keys. Default: what
155 =item B<gpg-delsig> [string]
157 Path to the GnuPG binary which is used to split off signatures. This was
158 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
161 =item B<secret-keyring> [string]
163 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
165 =item B<also-encrypt-to> [keyid, or list of keyids]
167 Additional keyids to encrypt messages to. Default: none.
169 =item B<gpg-sign-args> [string]
171 Additional commands to pass to gpg after the "sign" command.
174 =head2 Keyserver settings
176 =item B<keyserver> [string]
178 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
180 =item B<no-download> [boolean]
182 If true, then skip the step of fetching keys from the keyserver.
185 =item B<key-files> [list of files]
187 A list of files containing keys to be imported.
189 =head2 Signing settings
191 =item B<no-sign> [boolean]
193 If true, then skip the signing step. Default: B<0>.
195 =item B<ask-sign> [boolean]
197 If true, then pause before continuing to the signing step.
198 This is useful for offline signing. Default: B<0>.
200 =item B<export-sig-age> [seconds]
202 Don't export UIDs by default, on which your latest signature is older
203 than this age. Default: B<24*60*60> (i.e. one day).
205 =item B<local-user> [keyid, or list of keyids]
207 Select the key that is used for signing, in case you have more than one key.
208 With multiple keyids, sign with each key in turn.
212 =item B<mail> [boolean]
214 Whether to send mails. This is a quad-option, with which you can set the
215 behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for
216 each uid, with according defaults for the question. Default: B<ask-yes>.
218 In any case, the messages are also written to $CONFIG{'caffhome'}/keys/
220 =item B<mail-template> [string]
222 Email template which is used as the body text for the email sent out
223 instead of the default text if specified. The following perl variables
224 can be used in the template:
228 =item B<{owner}> [string]
230 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
232 =item B<{key}> [string]
234 The keyid of the key you signed.
236 =item B<{@uids}> [array]
238 The UIDs for which signatures are included in the mail.
242 =item B<reply-to> [string]
244 Add a Reply-To: header to messages sent. Default: none.
246 =item B<bcc> [string]
248 Address to send blind carbon copies to when sending mail.
251 =item B<mailer-send> [array]
253 Parameters to pass to Mail::Mailer.
254 This could for example be
256 $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ];
258 to use the perl SMTP client or
260 $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ];
262 to pass arguments to the sendmail program.
263 For more information run C<< perldoc Mail::Mailer >>.
264 Setting this option is strongly discouraged. Fix your local MTA
274 =item Peter Palfrader <peter@palfrader.org>
276 =item Christoph Berg <cb@df7cb.de>
282 http://pgp-tools.alioth.debian.org/
286 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
294 use File
::Temp
qw{tempdir
};
301 use GnuPG
::Interface
;
304 my $REVISION = '$Rev$';
305 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
306 my $VERSION = "0.0.0.$REVISION_NUMER";
312 print "[WARN] $line\n";
316 print "[NOTICE] $line\n";
320 print "[INFO] $line\n";
324 #print "[DEBUG] $line\n";
328 #print "[trace] $line\n";
332 #print "[trace2] $line\n";
336 sub generate_config
() {
337 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
338 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
341 # BSD does not have hostname -f, so we try without -f first
342 my $hostname = `hostname`;
343 $hostname = `hostname -f` unless $hostname =~ /\./;
345 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
347 if (defined $gecos) {
350 my $gpg = GnuPG
::Interface
->new();
352 $gpg->options->hash_init(
353 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
354 $gpg->options->meta_interactive( 0 );
355 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
356 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
357 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
361 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
364 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
365 unless (scalar @keys) {
366 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
367 @keys = qw{0123456789abcdef
89abcdef76543210
};
370 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
371 unless (defined $email) {
372 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
373 $email = $ENV{'LOGNAME'}.'@'.$hostname;
377 $gecos = 'Unknown Caff User';
378 $email = $ENV{'LOGNAME'}.'@'.$hostname;
379 @keys = qw{0123456789abcdef
89abcdef76543210
};
380 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
383 my $template = <<EOT;
384 # .caffrc -- vim:ft=perl:
385 # This file is in perl(1) format - see caff(1) for details.
387 $Cgecos\$CONFIG{'owner'} = '$gecos';
388 $Cemail\$CONFIG{'email'} = '$email';
389 #\$CONFIG{'reply-to'} = 'foo\@bla.org';
391 # You can get your long keyid from
392 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
394 # If you have a v4 key, it will simply be the last 16 digits of
398 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
399 # or, if you have more than one key:
400 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
401 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
403 # Select this/these keys to sign with
404 #\$CONFIG{'local-user'} = [ qw{@keys} ];
406 # Additionally encrypt messages for these keyids
407 #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ];
409 # Mail template to use for the encrypted part
410 #\$CONFIG{'mail-template'} = << 'EOM';
413 $template .= "#$_" foreach <DATA
>;
414 $template .= "#EOM\n";
418 sub check_executable
($$) {
419 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
420 # so we want to check manually.)
421 my ($purpose, $fn) = @_;
422 # Only check provided fnames with a slash in them.
423 return unless defined $fn;
425 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
427 for my $p (split(':', $ENV{PATH
})) {
428 return if -x
"$p/$fn";
430 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
435 my $config = $ENV{'HOME'} . '/.caffrc';
436 unless (-f
$config) {
437 print "No configfile $config present, I will use this template:\n";
438 my $template = generate_config
();
439 print "$template\nPlease edit $config and run caff again.\n";
440 open F
, ">$config" or die "$config: $!";
445 unless (scalar eval `cat $config`) {
446 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
449 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
450 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
451 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
452 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
453 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
454 for my $keyid (@
{$CONFIG{'keyid'}}) {
455 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
457 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
458 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
459 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
460 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
461 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
462 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
463 check_executable
("gpg", $CONFIG{'gpg'});
464 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
465 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
466 $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg'
467 unless defined $CONFIG{'secret-keyring'};
468 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
469 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
470 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
471 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
472 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
473 unless (defined $CONFIG{'mail-template'}) {
474 $CONFIG{'mail-template'} .= $_ foreach <DATA
>;
476 if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) {
477 $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ];
483 stdin
=> IO
::Handle
->new(),
484 stdout
=> IO
::Handle
->new(),
485 stderr
=> IO
::Handle
->new(),
486 status
=> IO
::Handle
->new() );
487 my $handles = GnuPG
::Handles
->new( %fds );
488 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
491 sub readwrite_gpg
($$$$$%) {
492 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
494 trace
("Entering readwrite_gpg.");
496 my ($first_line, undef) = split /\n/, $in;
497 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
499 local $INPUT_RECORD_SEPARATOR = undef;
500 my $sout = IO
::Select
->new();
501 my $sin = IO
::Select
->new();
504 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
506 $inputfd->blocking(0);
507 $stdoutfd->blocking(0);
508 $statusfd->blocking(0) if defined $statusfd;
509 $stderrfd->blocking(0);
510 $sout->add($stdoutfd);
511 $sout->add($stderrfd);
512 $sout->add($statusfd) if defined $statusfd;
515 my ($stdout, $stderr, $status) = ("", "", "");
516 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
517 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
519 my $readwrote_stuff_this_time = 0;
520 my $do_not_wait_on_select = 0;
521 my ($readyr, $readyw, $written);
522 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
523 if (defined $exitwhenstatusmatches) {
524 if ($status =~ /$exitwhenstatusmatches/m) {
525 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
526 if ($readwrote_stuff_this_time) {
527 trace
("read/write some more\n");
528 $do_not_wait_on_select = 1;
530 trace
("that's it in our while loop.\n");
536 $readwrote_stuff_this_time = 0;
537 trace
("select waiting for ".($sout->count())." fds.");
538 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
539 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
540 for my $wfd (@
$readyw) {
541 $readwrote_stuff_this_time = 1;
542 if (length($in) != $offset) {
543 trace
("writing to $wfd.");
544 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
547 if ($offset == length($in)) {
548 trace
("writing to $wfd done.");
549 unless ($options{'nocloseinput'}) {
551 trace
("$wfd closed.");
558 next unless (defined(@
$readyr)); # Wait some more.
560 for my $rfd (@
$readyr) {
561 $readwrote_stuff_this_time = 1;
563 trace
("reading from $rfd done.");
568 trace
("reading from $rfd.");
569 if ($rfd == $stdoutfd) {
571 trace2
("stdout is now $stdout\n================");
574 if (defined $statusfd && $rfd == $statusfd) {
576 trace2
("status is now $status\n================");
579 if ($rfd == $stderrfd) {
581 trace2
("stderr is now $stderr\n================");
586 trace
("readwrite_gpg done.");
587 return ($stdout, $stderr, $status);
591 my ($question, $default, $forceyes, $forceno) = @_;
593 my $yn = $default ?
'[Y/n]' : '[y/N]';
595 print $question,' ',$yn, ' ';
596 if ($forceyes && $forceno) {
597 print "$default (from config/command line)\n";
601 print "YES (from config/command line)\n";
605 print "NO (from config/command line)\n";
610 if (!defined $answer) {
611 $OUTPUT_AUTOFLUSH = 1;
613 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
614 "so you can't really use it with xargs. A patch against caff to read from\n".
615 "the terminal would be appreciated.\n".
616 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
619 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
620 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
623 my $result = $default;
624 $result = 1 if $answer =~ /y/i;
625 $result = 0 if $answer =~ /n/i;
633 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
634 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
635 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
636 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
637 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
640 my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/";
642 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
643 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
645 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
646 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
649 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
650 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
655 print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n";
659 my ($fd, $exitcode) = @_;
661 print $fd "Usage: $PROGRAM_NAME [-eERS] [-m <yes|ask-yes|ask-no|no>] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
662 print $fd "Consult the manual page for more information.\n";
667 # export key $keyid from $gnupghome
670 my ($gnupghome, $keyid) = @_;
672 my $gpg = GnuPG
::Interface
->new();
673 $gpg->call( $CONFIG{'gpg'} );
674 if (defined $gnupghome) {
675 $gpg->options->hash_init(
676 'homedir' => $gnupghome,
677 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
680 $gpg->options->hash_init(
681 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
684 $gpg->options->meta_interactive( 0 );
685 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
686 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
687 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
694 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
697 my ($gnupghome, $asciikey) = @_;
699 my $gpg = GnuPG
::Interface
->new();
700 $gpg->call( $CONFIG{'gpg'} );
701 $gpg->options->hash_init(
702 'homedir' => $gnupghome,
703 '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->import_keys(handles
=> $handles);
707 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
710 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
718 # Send an email to $address. If $can_encrypt is true then the mail
719 # will be PGP/MIME encrypted to $longkeyid.
721 # $longkeyid, $uid, and @attached will be used in the email and the template.
723 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
724 sub send_mail
($$$@
) {
725 my ($address, $can_encrypt, $key_id, @keys) = @_;
727 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
728 or die "Error creating template: $Text::Template::ERROR";
731 for my $key (@keys) {
732 push @uids, $key->{'text'};
734 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
736 owner
=> $CONFIG{'owner'}})
737 or die "Error filling template in: $Text::Template::ERROR";
739 my $message_entity = MIME
::Entity
->build(
740 Type
=> "text/plain",
742 Disposition
=> 'inline',
746 for my $key (@keys) {
747 $message_entity->attach(
748 Type
=> "application/pgp-keys",
749 Disposition
=> 'attachment',
751 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
752 Data
=> $key->{'key'},
753 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
757 my $message = $message_entity->stringify();
759 my $gpg = GnuPG
::Interface
->new();
760 $gpg->call( $CONFIG{'gpg'} );
761 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
762 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
764 $gpg->options->meta_interactive( 0 );
765 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
766 $gpg->options->push_recipients( $key_id );
767 if (defined $CONFIG{'also-encrypt-to'}) {
768 $gpg->options->push_recipients($_) foreach @
{$CONFIG{'also-encrypt-to'}};
770 my $pid = $gpg->encrypt(handles
=> $handles);
771 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
774 if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and
775 (defined $CONFIG{'also-encrypt-to'})) {
778 if (grep { $_ eq $keyid } @
{$CONFIG{'also-encrypt-to'}}) {
779 warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n".
780 "Try to update the key using gpg --homedir=$GNUPGHOME --import <exported key>\n".
781 "or try the following if you are slightly more daring:\n".
782 " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n");
786 warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n");
791 $message_entity = MIME
::Entity
->build(
792 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
795 $message_entity->attach(
796 Type
=> "application/pgp-encrypted",
797 Filename
=> "signedkey.msg",
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:s' => \
$params->{'mail'},
892 '--mail:s' => \
$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-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
916 # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no'
917 if ( $CONFIG{'no-mail'} || defined $params->{'no-mail'} ||
918 ( defined $params->{'mail'} && $params->{'mail'} eq 'no' ) ) {
919 $CONFIG{'mail'} = 'no';
920 } elsif ( defined $params->{'mail'} ) {
921 $CONFIG{'mail'} = $params->{'mail'};
923 $CONFIG{'mail'} = 'ask-yes';
926 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
927 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
929 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
931 for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument
933 $keyid =~ s/ //g; # gpg --fingerprint includes spaces
934 if ($keyid =~ /^[A-F0-9]{32}$/i) {
935 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
938 if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
939 print STDERR
"$keyid is not a keyid.\n";
942 push @KEYIDS, uc($keyid);
948 for my $keyid (@
{$CONFIG{'keyid'}}) {
949 my $gpg = GnuPG
::Interface
->new();
950 $gpg->call( $CONFIG{'gpg'} );
951 $gpg->options->hash_init(
952 'homedir' => $GNUPGHOME,
953 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
954 $gpg->options->meta_interactive( 0 );
955 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
956 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
957 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
961 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
963 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
964 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
965 my $key = export_key
(undef, $keyid);
966 if (!defined $key || $key eq '') {
967 warn ("Did not get key $keyid from your normal GnuPGHome\n");
970 my $result = import_key
($GNUPGHOME, $key);
972 warn ("Could not import $keyid into caff's gnupghome.\n");
978 ########################
979 # import keys from files
980 ########################
981 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
982 my $gpg = GnuPG
::Interface
->new();
983 $gpg->call( $CONFIG{'gpg'} );
984 $gpg->options->hash_init('homedir' => $GNUPGHOME);
985 $gpg->options->meta_interactive( 0 );
986 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
987 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
988 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
989 info
("Importing keys from $keyfile");
991 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
996 #############################
997 # receive keys from keyserver
998 #############################
1000 if ($CONFIG{'no-download'}) {
1001 @keyids_ok = @KEYIDS;
1003 info
("fetching keys, this will take a while...");
1005 my $gpg = GnuPG
::Interface
->new();
1006 $gpg->call( $CONFIG{'gpg'} );
1007 $gpg->options->hash_init(
1008 'homedir' => $GNUPGHOME,
1009 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
1010 $gpg->options->meta_interactive( 0 );
1011 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1012 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
1013 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1016 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1019 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1020 my %local_keyids = map { $_ => 1 } @KEYIDS;
1021 my $had_v3_keys = 0;
1022 for my $line (split /\n/, $status) {
1023 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1024 my $imported_key = $1;
1025 my $whole_fpr = $imported_key;
1026 my $long_keyid = substr($imported_key, -16);
1027 my $short_keyid = substr($imported_key, -8);
1029 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1030 $speced_key = $spec if $local_keyids{$spec};
1032 unless ($speced_key) {
1033 notice
("Imported unexpected key; got: $imported_key\n");
1036 debug
("Imported $imported_key for $speced_key");
1037 delete $local_keyids{$speced_key};
1038 unshift @keyids_ok, $imported_key;
1039 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1040 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1041 my $imported_key = $1;
1042 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.");
1045 notice
("got unknown reply from gpg: $line");
1048 if (scalar %local_keyids) {
1049 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1050 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1051 if (scalar keys %local_keyids == 1) {
1052 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1054 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1056 push @keyids_ok, keys %local_keyids;
1060 unless (@keyids_ok) {
1061 notice
("No keys to sign found");
1068 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1069 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1072 unless ($CONFIG{'no-sign'}) {
1074 if ($CONFIG{'local-user'}) {
1075 if (ref($CONFIG{'local-user'})) {
1076 @local_user = @
{$CONFIG{'local-user'}};
1078 @local_user = split /\s*,\s*/, $CONFIG{'local-user'};
1080 foreach (@local_user) {
1082 unless (/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
1083 print STDERR
"Local-user $_ is not a keyid.\n";
1089 @local_user = (undef);
1092 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1093 for my $keyid (@keyids_ok) {
1094 foreach my $local_user (@local_user) {
1096 push @command, $CONFIG{'gpg-sign'};
1097 push @command, '--local-user', $local_user if (defined $local_user);
1098 push @command, "--homedir=$GNUPGHOME";
1099 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1100 push @command, '--no-auto-check-trustdb';
1101 push @command, '--trust-model=always';
1102 push @command, '--edit', $keyid;
1103 push @command, 'sign';
1104 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1105 print join(' ', @command),"\n";
1115 for my $keyid (@keyids_ok) {
1118 my $gpg = GnuPG
::Interface
->new();
1119 $gpg->call( $CONFIG{'gpg'} );
1120 $gpg->options->hash_init(
1121 'homedir' => $GNUPGHOME,
1122 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1123 $gpg->options->meta_interactive( 0 );
1124 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1125 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1126 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1128 if ($stdout eq '') {
1129 warn ("No data from gpg for list-key $keyid\n");
1132 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1133 if (scalar @publine == 0) {
1134 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1137 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1138 if (scalar @publine > 0) {
1139 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1142 unless (defined $longkeyid) {
1143 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1146 unless (defined $flags) {
1147 warn ("Didn't find flags in --list-key of key $keyid.\n");
1150 my $can_encrypt = $flags =~ /E/;
1154 my $asciikey = export_key
($GNUPGHOME, $keyid);
1155 if ($asciikey eq '') {
1156 warn ("No data from gpg for export $keyid\n");
1163 my $this_uid_text = '';
1165 debug
("Doing key $keyid, uid $uid_number");
1166 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1168 # import into temporary gpghome
1169 ###############################
1170 my $result = import_key
($tempdir, $asciikey);
1172 warn ("Could not import $keyid into temporary gnupg.\n");
1178 $gpg = GnuPG
::Interface
->new();
1179 $gpg->call( $CONFIG{'gpg-delsig'} );
1180 $gpg->options->hash_init(
1181 'homedir' => $tempdir,
1182 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1183 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1184 $pid = $gpg->wrap_call(
1185 commands
=> [ '--edit' ],
1186 command_args
=> [ $keyid ],
1187 handles
=> $handles );
1189 debug
("Starting edit session");
1190 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1194 my $number_of_subkeys = 0;
1198 my $delete_some = 0;
1199 debug
("Parsing stdout output.");
1200 for my $line (split /\n/, $stdout) {
1201 debug
("Checking line $line");
1202 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1203 if ($type eq 'sub') {
1204 $number_of_subkeys++;
1206 next unless ($type eq 'uid' || $type eq 'uat');
1207 debug
("line is interesting.");
1208 if ($uid_number != $i) {
1209 debug
("mark for deletion.");
1210 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1215 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1216 $is_uat = $type eq 'uat';
1220 debug
("Parsing stdout output done.");
1221 unless ($have_one) {
1222 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1223 info
("key $keyid done.");
1227 my $prune_some_sigs_on_uid;
1228 my $prune_all_sigs_on_uid;
1230 debug
("handling attribute userid of key $keyid.");
1231 if ($uid_number == 1) {
1232 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1233 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1235 $prune_some_sigs_on_uid = 1;
1236 $prune_all_sigs_on_uid = 2;
1238 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1239 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1241 $prune_some_sigs_on_uid = 2;
1242 $prune_all_sigs_on_uid = 1;
1245 $prune_some_sigs_on_uid = 1;
1249 debug
("need to delete $delete_some uids.");
1250 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1251 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1256 if ($number_of_subkeys > 0) {
1257 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1258 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1260 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1261 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1266 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1267 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1268 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1269 if (defined $prune_all_sigs_on_uid) {
1270 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1271 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1272 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1276 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1279 my $asciikey = export_key
($tempdir, $keyid);
1280 if ($asciikey eq '') {
1281 warn ("No data from gpg for export $keyid\n");
1285 if ($signed_by_me) {
1286 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1287 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1290 my $keydir = "$KEYSBASE/$DATE_STRING";
1291 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1293 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1294 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1295 print KEY
$asciikey;
1298 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1300 info
("$longkeyid $uid_number $this_uid_text done.");
1302 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1306 if (scalar @UIDS == 0) {
1307 info
("found no signed uids for $keyid");
1309 next if ($CONFIG{'mail'} eq 'no'); # do not send mail
1312 for my $uid (@UIDS) {
1313 trace
("UID: $uid->{'text'}\n");
1314 if ($uid->{'is_uat'}) {
1315 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1316 push @attached, $uid if $attach;
1317 } elsif ($uid->{'text'} !~ /@/) {
1318 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1319 push @attached, $uid if $attach;
1323 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1324 for my $uid (@UIDS) {
1325 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1326 my $address = $uid->{'text'};
1327 $address =~ s/.*<(.*)>.*/$1/;
1328 if (ask
("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) {
1329 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1330 if (defined $mail) {
1331 my $keydir = "$KEYSBASE/$DATE_STRING";
1332 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1333 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1337 warn "Generating mail failed.\n";
1346 ###########################
1347 # the default mail template
1348 ###########################
1353 please find attached the user id
{(scalar @uids >= 2 ?
's' : '')}
1354 {foreach $uid (@uids) {
1355 $OUT .= "\t".$uid."\n";
1356 };}of your key
{$key} signed by me
.
1358 If you have multiple user ids
, I sent the signature
for each user id
1359 separately to that user id
's associated email address. You can import
1360 the signatures by running each through `gpg --import`.
1362 Note that I did not upload your key to any keyservers. If you want this
1363 new signature to be available to others, please upload it yourself.
1364 With GnuPG this can be done using
1365 gpg --keyserver subkeys.pgp.net --send-key {$key}
1367 If you have any questions, don't hesitate to ask
.