3 # caff -- CA - Fire and Forget
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 # Copyright (c) 2005 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.
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, 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>.
140 =head2 General settings
142 =item B<caffhome> [string]
144 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
146 =head2 GnuPG settings
148 =item B<gpg> [string]
150 Path to the GnuPG binary. Default: B<gpg>.
152 =item B<gpg-sign> [string]
154 Path to the GnuPG binary which is used to sign keys. Default: what
157 =item B<gpg-delsig> [string]
159 Path to the GnuPG binary which is used to split off signatures. This was
160 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
163 =item B<secret-keyring> [string]
165 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
167 =item B<also-encrypt-to> [keyid]
169 An additional keyid to encrypt messages to. Default: none.
171 =item B<gpg-sign-args> [string]
173 Additional arguments to pass to gpg. Default: none.
175 =head2 Keyserver settings
177 =item B<keyserver> [string]
179 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
181 =item B<no-download> [boolean]
183 If true, then skip the step of fetching keys from the keyserver.
186 =item B<key-files> [list of files]
188 A list of files containing keys to be imported.
190 =head2 Signing settings
192 =item B<no-sign> [boolean]
194 If true, then skip the signing step. Default: B<0>.
196 =item B<ask-sign> [boolean]
198 If true, then pause before continuing to the signing step.
199 This is useful for offline signing. Default: B<0>.
201 =item B<export-sig-age> [seconds]
203 Don't export UIDs by default, on which your latest signature is older
204 than this age. Default: B<24*60*60> (i.e. one day).
208 =item B<mail> [boolean]
210 Do not prompt for sending mail, just do it. Default: B<0>.
212 =item B<no-mail> [boolean]
214 Do not prompt for sending mail. The messages are still written to
215 $CONFIG{caffhome}/keys/. Default: B<0>.
217 =item B<mail-template> [string]
219 Email template which is used as the body text for the email sent out
220 instead of the default text if specified. The following perl variables
221 can be used in the template:
225 =item B<{owner}> [string]
227 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
229 =item B<{key}> [string]
231 The keyid of the key you signed.
233 =item B<{@uids}> [array]
235 The UIDs for which signatures are included in the mail.
239 =item B<reply-to> [string]
241 Add a Reply-To: header to messages sent. Default: none.
243 =item B<bcc> [string]
245 Address to send blind carbon copies to when sending mail.
248 =item B<mailer-send> [array]
250 Parameters to pass to Mail::Mailer.
251 This could for example be
253 $CONFIG{mailer-send} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ]
255 to use the perl SMTP client or
257 $CONFIG{mailer-send} = [ 'sendmail', '-o8' ]
259 to pass arguments to the sendmail program.
260 For more information run C<< perldoc Mail::Mailer >>.
261 Setting this option is strongly discouraged. Fix your local MTA
271 =item Peter Palfrader <peter@palfrader.org>
273 =item Christoph Berg <cb@df7cb.de>
279 http://pgp-tools.alioth.debian.org/
283 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
291 use File
::Temp
qw{tempdir
};
297 use GnuPG
::Interface
;
300 my $REVISION = '$Rev$';
301 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
302 my $VERSION = "0.0.0.$REVISION_NUMER";
308 print "[WARN] $line\n";
312 print "[NOTICE] $line\n";
316 print "[INFO] $line\n";
320 #print "[DEBUG] $line\n";
324 #print "[trace] $line\n";
328 #print "[trace2] $line\n";
332 sub generate_config
() {
333 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
334 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
337 # BSD does not have hostname -f, so we try without -f first
338 my $hostname = `hostname`;
339 $hostname = `hostname -f` unless $hostname =~ /\./;
341 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
343 if (defined $gecos) {
346 my $gpg = GnuPG
::Interface
->new();
348 $gpg->options->hash_init(
349 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
350 $gpg->options->meta_interactive( 0 );
351 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
352 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
353 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
357 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
360 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
361 unless (scalar @keys) {
362 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
363 @keys = qw{0123456789abcdef
89abcdef76543210
};
366 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
367 unless (defined $email) {
368 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
369 $email = $ENV{'LOGNAME'}.'@'.$hostname;
373 $gecos = 'Unknown Caff User';
374 $email = $ENV{'LOGNAME'}.'@'.$hostname;
375 @keys = qw{0123456789abcdef
89abcdef76543210
};
376 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
380 # .caffrc -- vim:syntax=perl:
381 # This file is in perl(1) format - see caff(1) for details.
383 $Cgecos\$CONFIG{'owner'} = '$gecos';
384 $Cemail\$CONFIG{'email'} = '$email';
386 # you can get your long keyid from
387 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
389 # if you have a v4 key, it will simply be the last 16 digits of
393 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
394 # or, if you have more than one key:
395 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
397 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
401 sub check_executable
($$) {
402 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
403 # so we want to check manually.)
404 my ($purpose, $fn) = @_;
405 # Only check provided fnames with a slash in them.
406 return unless defined $fn;
408 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
410 for my $p (split(':', $ENV{PATH
})) {
411 return if -x
"$p/$fn";
413 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
418 my $config = $ENV{'HOME'} . '/.caffrc';
419 unless (-f
$config) {
420 print "No configfile $config present, I will use this template:\n";
421 my $template = generate_config
();
422 print "$template\nPlease edit $config and run caff again.\n";
423 open F
, ">$config" or die "$config: $!";
428 unless (scalar eval `cat $config`) {
429 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
432 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
433 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
434 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
435 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
436 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
437 for my $keyid (@
{$CONFIG{'keyid'}}) {
438 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
440 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
441 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
442 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
443 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
444 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
445 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
446 check_executable
("gpg", $CONFIG{'gpg'});
447 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
448 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
449 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
450 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
451 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
452 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
453 $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'};
454 die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY');
455 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
458 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
459 {foreach $uid (@uids) {
460 $OUT .= "\t".$uid."\n";
461 };} of your key {$key} signed by me.
463 Note that I did not upload your key to any keyservers.
464 If you have multiple user ids, I sent the signature for each user id
465 separately to that user id's associated email address. You can import
466 the signatures by running each through `gpg --import`.
468 If you want this new signature to be available to others, please upload
469 it yourself. With GnuPG this can be done using
470 gpg --keyserver subkeys.pgp.net --send-key {$key}
472 If you have any questions, don't hesitate to ask.
481 stdin
=> IO
::Handle
->new(),
482 stdout
=> IO
::Handle
->new(),
483 stderr
=> IO
::Handle
->new(),
484 status
=> IO
::Handle
->new() );
485 my $handles = GnuPG
::Handles
->new( %fds );
486 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
489 sub readwrite_gpg
($$$$$%) {
490 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
492 trace
("Entering readwrite_gpg.");
494 my ($first_line, undef) = split /\n/, $in;
495 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
497 local $INPUT_RECORD_SEPARATOR = undef;
498 my $sout = IO
::Select
->new();
499 my $sin = IO
::Select
->new();
502 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
504 $inputfd->blocking(0);
505 $stdoutfd->blocking(0);
506 $statusfd->blocking(0) if defined $statusfd;
507 $stderrfd->blocking(0);
508 $sout->add($stdoutfd);
509 $sout->add($stderrfd);
510 $sout->add($statusfd) if defined $statusfd;
513 my ($stdout, $stderr, $status) = ("", "", "");
514 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
515 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
517 my $readwrote_stuff_this_time = 0;
518 my $do_not_wait_on_select = 0;
519 my ($readyr, $readyw, $written);
520 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
521 if (defined $exitwhenstatusmatches) {
522 if ($status =~ /$exitwhenstatusmatches/m) {
523 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
524 if ($readwrote_stuff_this_time) {
525 trace
("read/write some more\n");
526 $do_not_wait_on_select = 1;
528 trace
("that's it in our while loop.\n");
534 $readwrote_stuff_this_time = 0;
535 trace
("select waiting for ".($sout->count())." fds.");
536 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
537 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
538 for my $wfd (@
$readyw) {
539 $readwrote_stuff_this_time = 1;
540 if (length($in) != $offset) {
541 trace
("writing to $wfd.");
542 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
545 if ($offset == length($in)) {
546 trace
("writing to $wfd done.");
547 unless ($options{'nocloseinput'}) {
549 trace
("$wfd closed.");
556 next unless (defined(@
$readyr)); # Wait some more.
558 for my $rfd (@
$readyr) {
559 $readwrote_stuff_this_time = 1;
561 trace
("reading from $rfd done.");
566 trace
("reading from $rfd.");
567 if ($rfd == $stdoutfd) {
569 trace2
("stdout is now $stdout\n================");
572 if (defined $statusfd && $rfd == $statusfd) {
574 trace2
("status is now $status\n================");
577 if ($rfd == $stderrfd) {
579 trace2
("stderr is now $stderr\n================");
584 trace
("readwrite_gpg done.");
585 return ($stdout, $stderr, $status);
589 my ($question, $default, $forceyes, $forceno) = @_;
591 my $yn = $default ?
'[Y/n]' : '[y/N]';
593 print $question,' ',$yn, ' ';
594 if ($forceyes && $forceno) {
595 print "$default (from config/command line)\n";
599 print "YES (from config/command line)\n";
603 print "NO (from config/command line)\n";
608 if (!defined $answer) {
609 $OUTPUT_AUTOFLUSH = 1;
611 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
612 "so you can't really use it with xargs. A patch against caff to read from\n".
613 "the terminal would be appreciated.\n".
614 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
617 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
618 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
621 my $result = $default;
622 $result = 1 if $answer =~ /y/i;
623 $result = 0 if $answer =~ /n/i;
631 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
632 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
633 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
634 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
635 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
638 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
640 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
641 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
643 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
644 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
647 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
648 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
653 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
657 my ($fd, $exitcode) = @_;
659 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
660 print $fd "Consult the manual page for more information.\n";
665 # export key $keyid from $gnupghome
668 my ($gnupghome, $keyid) = @_;
670 my $gpg = GnuPG
::Interface
->new();
671 $gpg->call( $CONFIG{'gpg'} );
672 if (defined $gnupghome) {
673 $gpg->options->hash_init(
674 'homedir' => $gnupghome,
675 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
678 $gpg->options->hash_init(
679 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
682 $gpg->options->meta_interactive( 0 );
683 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
684 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
685 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
692 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
695 my ($gnupghome, $asciikey) = @_;
697 my $gpg = GnuPG
::Interface
->new();
698 $gpg->call( $CONFIG{'gpg'} );
699 $gpg->options->hash_init(
700 'homedir' => $gnupghome,
701 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
702 $gpg->options->meta_interactive( 0 );
703 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
704 my $pid = $gpg->import_keys(handles
=> $handles);
705 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
708 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
716 # Send an email to $address. If $can_encrypt is true then the mail
717 # will be PGP/MIME encrypted to $longkeyid.
719 # $longkeyid, $uid, and @attached will be used in the email and the template.
721 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
722 sub send_mail
($$$@
) {
723 my ($address, $can_encrypt, $key_id, @keys) = @_;
725 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
726 or die "Error creating template: $Text::Template::ERROR";
729 for my $key (@keys) {
730 push @uids, $key->{'text'};
732 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
734 owner
=> $CONFIG{'owner'}})
735 or die "Error filling template in: $Text::Template::ERROR";
737 my $message_entity = MIME
::Entity
->build(
738 Type
=> "text/plain",
740 Disposition
=> 'inline',
744 for my $key (@keys) {
745 $message_entity->attach(
746 Type
=> "application/pgp-keys",
747 Disposition
=> 'attachment',
749 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
750 Data
=> $key->{'key'},
751 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
755 my $message = $message_entity->stringify();
757 my $gpg = GnuPG
::Interface
->new();
758 $gpg->call( $CONFIG{'gpg'} );
759 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
760 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
762 $gpg->options->meta_interactive( 0 );
763 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
764 $gpg->options->push_recipients( $key_id );
765 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
766 my $pid = $gpg->encrypt(handles
=> $handles);
767 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
770 warn ("No data from gpg for list-key $key_id\n");
775 $message_entity = MIME
::Entity
->build(
776 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
779 $message_entity->attach(
780 Type
=> "application/pgp-encrypted",
781 Disposition
=> 'attachment',
783 Data
=> "Version: 1\n");
785 $message_entity->attach(
786 Type
=> "application/octet-stream",
787 Filename
=> 'msg.asc',
788 Disposition
=> 'inline',
793 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
794 $message_entity->head->add("To", $address);
795 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
796 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
797 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
798 $message_entity->head->add("User-Agent", $USER_AGENT);
799 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);
800 $message_entity->send(@
{$CONFIG{'mailer-send'}});
801 $message_entity->stringify();
805 # clean up a UID so that it can be used on the FS.
807 sub sanitize_uid
($) {
811 $good_uid =~ tr
#/:\\#_#;
812 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
816 sub delete_signatures
($$$$$$) {
817 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
819 my $signed_by_me = 0;
821 my ($stdout, $stderr, $status) =
822 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
824 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
825 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
826 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
827 $stdout =~ s/\n/\\n/g;
828 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
829 my $line = pop @sigline;
831 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
832 debug
("[sigremoval] doing line $line.");
833 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
834 if ($signer eq $longkeyid) {
835 debug
("[sigremoval] selfsig ($signer).");
837 } elsif (grep { $signer eq $_ } @
{$keyids}) {
838 debug
("[sigremoval] signed by us ($signer).");
840 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
842 debug
("[sigremoval] not interested in that sig ($signer).");
846 debug
("[sigremoval] no sig line here, only got: ".$stdout);
848 ($stdout, $stderr, $status) =
849 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
852 return $signed_by_me;
861 Getopt
::Long
::config
('bundling');
863 '-h' => \
$params->{'help'},
864 '--help' => \
$params->{'help'},
865 '--version' => \
$params->{'version'},
866 '-V' => \
$params->{'version'},
867 '-u=s' => \
$params->{'local-user'},
868 '--local-user=s' => \
$params->{'local-user'},
869 '-e' => \
$params->{'export-old'},
870 '--export-old' => \
$params->{'export-old'},
871 '-E' => \
$params->{'no-export-old'},
872 '--no-export-old' => \
$params->{'no-export-old'},
873 '-m' => \
$params->{'mail'},
874 '--mail' => \
$params->{'mail'},
875 '-M' => \
$params->{'no-mail'},
876 '--no-mail' => \
$params->{'no-mail'},
877 '-R' => \
$params->{'no-download'},
878 '--no-download' => \
$params->{'no-download'},
879 '-S' => \
$params->{'no-sign'},
880 '--no-sign' => \
$params->{'no-sign'},
881 '--key-file=s@' => \
$params->{'key-files'},
885 if ($params->{'help'}) {
888 if ($params->{'version'}) {
892 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
896 if ($params->{'local-user'}) {
897 $USER = $params->{'local-user'};
899 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
900 print STDERR
"-u $USER is not a keyid.\n";
906 for my $keyid (@ARGV) {
908 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
909 if ($keyid =~ /^[A-F0-9]{32}$/) {
910 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
913 print STDERR
"$keyid is not a keyid.\n";
916 push @KEYIDS, uc($keyid);
919 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
920 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
921 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
922 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
923 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
929 for my $keyid (@
{$CONFIG{'keyid'}}) {
930 my $gpg = GnuPG
::Interface
->new();
931 $gpg->call( $CONFIG{'gpg'} );
932 $gpg->options->hash_init(
933 'homedir' => $GNUPGHOME,
934 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
935 $gpg->options->meta_interactive( 0 );
936 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
937 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
938 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
942 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
944 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
945 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
946 my $key = export_key
(undef, $keyid);
947 if (!defined $key || $key eq '') {
948 warn ("Did not get key $keyid from your normal GnuPGHome\n");
951 my $result = import_key
($GNUPGHOME, $key);
953 warn ("Could not import $keyid into caff's gnupghome.\n");
959 ########################
960 # import keys from files
961 ########################
962 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
963 my $gpg = GnuPG
::Interface
->new();
964 $gpg->call( $CONFIG{'gpg'} );
965 $gpg->options->hash_init('homedir' => $GNUPGHOME);
966 $gpg->options->meta_interactive( 0 );
967 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
968 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
969 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
970 info
("Importing keys from $keyfile");
972 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
977 #############################
978 # receive keys from keyserver
979 #############################
981 if ($CONFIG{'no-download'}) {
982 @keyids_ok = @KEYIDS;
984 info
("fetching keys, this will take a while...");
986 my $gpg = GnuPG
::Interface
->new();
987 $gpg->call( $CONFIG{'gpg'} );
988 $gpg->options->hash_init(
989 'homedir' => $GNUPGHOME,
990 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
991 $gpg->options->meta_interactive( 0 );
992 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
993 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
994 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
997 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
1000 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
1001 my %local_keyids = map { $_ => 1 } @KEYIDS;
1002 my $had_v3_keys = 0;
1003 for my $line (split /\n/, $status) {
1004 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
1005 my $imported_key = $1;
1006 my $whole_fpr = $imported_key;
1007 my $long_keyid = substr($imported_key, -16);
1008 my $short_keyid = substr($imported_key, -8);
1010 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
1011 $speced_key = $spec if $local_keyids{$spec};
1013 unless ($speced_key) {
1014 notice
("Imported unexpected key; got: $imported_key\n");
1017 debug
("Imported $imported_key for $speced_key");
1018 delete $local_keyids{$speced_key};
1019 unshift @keyids_ok, $imported_key;
1020 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
1021 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
1022 my $imported_key = $1;
1023 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.");
1026 notice
("got unknown reply from gpg: $line");
1029 if (scalar %local_keyids) {
1030 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1031 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1032 if (scalar %local_keyids == 1) {
1033 mywarn
("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid.");
1035 mywarn
("Assuming ". (join ' ', keys %local_keyids)." are fine keyids.");
1037 push @keyids_ok, keys %local_keyids;
1041 unless (@keyids_ok) {
1042 notice
("No keys to sign found");
1049 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1050 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1053 unless ($CONFIG{'no-sign'}) {
1054 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1055 for my $keyid (@keyids_ok) {
1057 push @command, $CONFIG{'gpg-sign'};
1058 push @command, '--local-user', $USER if (defined $USER);
1059 push @command, "--homedir=$GNUPGHOME";
1060 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1061 push @command, '--no-auto-check-trustdb';
1062 push @command, '--trust-model=always';
1063 push @command, '--edit', $keyid;
1064 push @command, 'sign';
1065 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1066 print join(' ', @command),"\n";
1075 for my $keyid (@keyids_ok) {
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
--with
-colons
--fixed
-list
-mode
} ] );
1083 $gpg->options->meta_interactive( 0 );
1084 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1085 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1086 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1088 if ($stdout eq '') {
1089 warn ("No data from gpg for list-key $keyid\n");
1092 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1093 if (scalar @publine == 0) {
1094 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1097 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1098 if (scalar @publine > 0) {
1099 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1102 unless (defined $longkeyid) {
1103 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1106 unless (defined $flags) {
1107 warn ("Didn't find flags in --list-key of key $keyid.\n");
1110 my $can_encrypt = $flags =~ /E/;
1114 my $asciikey = export_key
($GNUPGHOME, $keyid);
1115 if ($asciikey eq '') {
1116 warn ("No data from gpg for export $keyid\n");
1123 my $this_uid_text = '';
1125 debug
("Doing key $keyid, uid $uid_number");
1126 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1128 # import into temporary gpghome
1129 ###############################
1130 my $result = import_key
($tempdir, $asciikey);
1132 warn ("Could not import $keyid into temporary gnupg.\n");
1138 $gpg = GnuPG
::Interface
->new();
1139 $gpg->call( $CONFIG{'gpg-delsig'} );
1140 $gpg->options->hash_init(
1141 'homedir' => $tempdir,
1142 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1143 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1144 $pid = $gpg->wrap_call(
1145 commands
=> [ '--edit' ],
1146 command_args
=> [ $keyid ],
1147 handles
=> $handles );
1149 debug
("Starting edit session");
1150 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1154 my $number_of_subkeys = 0;
1158 my $delete_some = 0;
1159 debug
("Parsing stdout output.");
1160 for my $line (split /\n/, $stdout) {
1161 debug
("Checking line $line");
1162 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1163 if ($type eq 'sub') {
1164 $number_of_subkeys++;
1166 next unless ($type eq 'uid' || $type eq 'uat');
1167 debug
("line is interesting.");
1168 if ($uid_number != $i) {
1169 debug
("mark for deletion.");
1170 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1175 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1176 $is_uat = $type eq 'uat';
1180 debug
("Parsing stdout output done.");
1181 unless ($have_one) {
1182 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1183 info
("key $keyid done.");
1187 my $prune_some_sigs_on_uid;
1188 my $prune_all_sigs_on_uid;
1190 debug
("handling attribute userid of key $keyid.");
1191 if ($uid_number == 1) {
1192 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1193 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1195 $prune_some_sigs_on_uid = 1;
1196 $prune_all_sigs_on_uid = 2;
1198 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1199 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1201 $prune_some_sigs_on_uid = 2;
1202 $prune_all_sigs_on_uid = 1;
1205 $prune_some_sigs_on_uid = 1;
1209 debug
("need to delete $delete_some uids.");
1210 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1211 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1216 if ($number_of_subkeys > 0) {
1217 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1218 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1220 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1221 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1226 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1227 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1228 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1229 if (defined $prune_all_sigs_on_uid) {
1230 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1231 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1232 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1236 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1239 my $asciikey = export_key
($tempdir, $keyid);
1240 if ($asciikey eq '') {
1241 warn ("No data from gpg for export $keyid\n");
1245 if ($signed_by_me) {
1246 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1247 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1250 my $keydir = "$KEYSBASE/$DATE_STRING";
1251 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1253 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1254 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1255 print KEY
$asciikey;
1258 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1260 info
("$longkeyid $uid_number $this_uid_text done.");
1262 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1266 if (scalar @UIDS == 0) {
1267 info
("found no signed uids for $keyid");
1269 next if $CONFIG{'no-mail'}; # do not send mail
1272 for my $uid (@UIDS) {
1273 trace
("UID: $uid->{'text'}\n");
1274 if ($uid->{'is_uat'}) {
1275 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1276 push @attached, $uid if $attach;
1277 } elsif ($uid->{'text'} !~ /@/) {
1278 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1279 push @attached, $uid if $attach;
1283 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1284 for my $uid (@UIDS) {
1285 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1286 my $address = $uid->{'text'};
1287 $address =~ s/.*<(.*)>.*/$1/;
1288 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1289 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1291 my $keydir = "$KEYSBASE/$DATE_STRING";
1292 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1293 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");