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.
59 =item B<-e>, B<--export-old>
61 Export old signatures. Default is to ask the user for each old signature.
63 =item B<-E>, B<--no-export-old>
65 Do not export old signatures. Default is to ask the user for each old
68 =item B<-m>, B<--mail>
70 Send mail after signing. Default is to ask the user for each uid.
72 =item B<-M>, B<--no-mail>
74 Do not send mail after signing. Default is to ask the user for each uid.
76 =item B<-R>, B<--no-download>
78 Do not retrieve the key to be signed from a keyserver.
80 =item B<-S>, B<--no-sign>
84 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
86 Select the key that is used for signing, in case you have more than one key.
88 =item B<--key-file> I<file>
90 Import keys from file. Can be supplied more than once.
98 =item $HOME/.caffrc - configuration file
100 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
102 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
104 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
106 useful options include use-agent, default-cert-level, etc.
110 =head1 CONFIGURATION FILE OPTIONS
112 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
113 The file is generated when it does not exist.
117 $CONFIG{owner} = q{Peter Palfrader};
118 $CONFIG{email} = q{peter@palfrader.org};
119 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
121 =head2 Required basic settings
125 =item B<owner> [string]
127 Your name. B<REQUIRED>.
129 =item B<email> [string]
131 Your email address, used in From: lines. B<REQUIRED>.
133 =item B<keyid> [list of keyids]
135 A list of your keys. This is used to determine which signatures to keep
136 in the pruning step. If you select a key using B<-u> it has to be in
137 this list. B<REQUIRED>.
139 =head2 General settings
141 =item B<caffhome> [string]
143 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
145 =head2 GnuPG settings
147 =item B<gpg> [string]
149 Path to the GnuPG binary. Default: B<gpg>.
151 =item B<gpg-sign> [string]
153 Path to the GnuPG binary which is used to sign keys. Default: what
156 =item B<gpg-delsig> [string]
158 Path to the GnuPG binary which is used to split off signatures. This was
159 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
162 =item B<secret-keyring> [string]
164 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
166 =item B<also-encrypt-to> [keyid]
168 An additional keyid to encrypt messages to. Default: none.
170 =item B<gpg-sign-args> [string]
172 Additional arguments to pass to gpg. Default: none.
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).
207 =item B<mail> [boolean]
209 Do not prompt for sending mail, just do it. Default: B<0>.
211 =item B<no-mail> [boolean]
213 Do not prompt for sending mail. The messages are still written to
214 $CONFIG{caffhome}/keys/. Default: B<0>.
216 =item B<mail-template> [string]
218 Email template which is used as the body text for the email sent out
219 instead of the default text if specified. The following perl variables
220 can be used in the template:
224 =item B<{owner}> [string]
226 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
228 =item B<{key}> [string]
230 The keyid of the key you signed.
232 =item B<{@uids}> [array]
234 The UIDs for which signatures are included in the mail.
238 =item B<reply-to> [string]
240 Add a Reply-To: header to messages sent. Default: none.
242 =item B<bcc> [string]
244 Address to send blind carbon copies to when sending mail.
253 =item Peter Palfrader <peter@palfrader.org>
255 =item Christoph Berg <cb@df7cb.de>
261 http://pgp-tools.alioth.debian.org/
265 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
273 use File
::Temp
qw{tempdir
};
279 use GnuPG
::Interface
;
282 my $REVISION = '$Rev$';
283 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
284 my $VERSION = "0.0.0.$REVISION_NUMER";
290 print "[NOTICE] $line\n";
294 print "[INFO] $line\n";
298 #print "[DEBUG] $line\n";
302 #print "[trace] $line\n";
306 #print "[trace2] $line\n";
310 sub generate_config
() {
311 notice
("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
312 my $gecos = defined $ENV{'LOGNAME'} ?
(getpwnam($ENV{LOGNAME
}))[6] : undef;
315 my $hostname = `hostname -f`;
317 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
318 if (defined $gecos) {
321 my $gpg = GnuPG
::Interface
->new();
323 $gpg->options->hash_init(
324 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
325 $gpg->options->meta_interactive( 0 );
326 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
327 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
328 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
332 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
335 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
336 unless (scalar @keys) {
337 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
338 @keys = qw{0123456789abcdef
89abcdef76543210
};
341 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
342 unless (defined $email) {
343 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
344 $email = $ENV{'LOGNAME'}.'@'.$hostname;
348 $gecos = 'Unknown Caff User';
349 $email = $ENV{'LOGNAME'}.'@'.$hostname;
350 @keys = qw{0123456789abcdef
89abcdef76543210
};
351 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
355 # .caffrc -- vim:syntax=perl:
356 # This file is in perl(1) format - see caff(1) for details.
358 $Cgecos\$CONFIG{'owner'} = '$gecos';
359 $Cemail\$CONFIG{'email'} = '$email';
361 # you can get your long keyid from
362 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
364 # if you have a v4 key, it will simply be the last 16 digits of
368 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
369 # or, if you have more than one key:
370 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
372 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
376 sub check_executable
($$) {
377 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
378 # so we want to check manually.)
379 my ($purpose, $fn) = @_;
380 # Only check provided fnames with a slash in them.
381 return unless defined $fn;
383 die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x
$fn;
385 for my $p (split(':', $ENV{PATH
})) {
386 return if -x
"$p/$fn";
388 die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x
$fn;
393 my $config = $ENV{'HOME'} . '/.caffrc';
394 unless (-f
$config) {
395 print "No configfile $config present, I will use this template:\n";
396 my $template = generate_config
();
397 print "$template\nPlease edit $config and run caff again.\n";
398 open F
, ">$config" or die "$config: $!";
403 unless (scalar eval `cat $config`) {
404 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
407 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
408 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
409 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
410 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
411 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
412 for my $keyid (@
{$CONFIG{'keyid'}}) {
413 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
415 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
416 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
417 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
418 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
419 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
420 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
421 check_executable
("gpg", $CONFIG{'gpg'});
422 check_executable
("gpg-sign", $CONFIG{'gpg-sign'});
423 check_executable
("gpg-delsig", $CONFIG{'gpg-delsig'});
424 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
425 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
426 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
427 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
428 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
431 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
432 {foreach $uid (@uids) {
433 $OUT .= "\t".$uid."\n";
434 };} of your key {$key} signed by me.
436 Note that I did not upload your key to any keyservers.
437 If you have multiple user ids, I sent the signature for each user id
438 separately to that user id's associated email address. You can import
439 the signatures by running each through `gpg --import`.
441 If you want this new signature to be available to others, please upload
442 it yourself. With GnuPG this can be done using
443 gpg --keyserver subkeys.pgp.net --send-key {$key}
445 If you have any questions, don't hesitate to ask.
454 stdin
=> IO
::Handle
->new(),
455 stdout
=> IO
::Handle
->new(),
456 stderr
=> IO
::Handle
->new(),
457 status
=> IO
::Handle
->new() );
458 my $handles = GnuPG
::Handles
->new( %fds );
459 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
462 sub readwrite_gpg
($$$$$%) {
463 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
465 trace
("Entering readwrite_gpg.");
467 my ($first_line, undef) = split /\n/, $in;
468 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
470 local $INPUT_RECORD_SEPARATOR = undef;
471 my $sout = IO
::Select
->new();
472 my $sin = IO
::Select
->new();
475 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
477 $inputfd->blocking(0);
478 $stdoutfd->blocking(0);
479 $statusfd->blocking(0) if defined $statusfd;
480 $stderrfd->blocking(0);
481 $sout->add($stdoutfd);
482 $sout->add($stderrfd);
483 $sout->add($statusfd) if defined $statusfd;
486 my ($stdout, $stderr, $status) = ("", "", "");
487 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
488 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
490 my $readwrote_stuff_this_time = 0;
491 my $do_not_wait_on_select = 0;
492 my ($readyr, $readyw, $written);
493 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
494 if (defined $exitwhenstatusmatches) {
495 if ($status =~ /$exitwhenstatusmatches/m) {
496 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
497 if ($readwrote_stuff_this_time) {
498 trace
("read/write some more\n");
499 $do_not_wait_on_select = 1;
501 trace
("that's it in our while loop.\n");
507 $readwrote_stuff_this_time = 0;
508 trace
("select waiting for ".($sout->count())." fds.");
509 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
510 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
511 for my $wfd (@
$readyw) {
512 $readwrote_stuff_this_time = 1;
513 if (length($in) != $offset) {
514 trace
("writing to $wfd.");
515 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
518 if ($offset == length($in)) {
519 trace
("writing to $wfd done.");
520 unless ($options{'nocloseinput'}) {
522 trace
("$wfd closed.");
529 next unless (defined(@
$readyr)); # Wait some more.
531 for my $rfd (@
$readyr) {
532 $readwrote_stuff_this_time = 1;
534 trace
("reading from $rfd done.");
539 trace
("reading from $rfd.");
540 if ($rfd == $stdoutfd) {
542 trace2
("stdout is now $stdout\n================");
545 if (defined $statusfd && $rfd == $statusfd) {
547 trace2
("status is now $status\n================");
550 if ($rfd == $stderrfd) {
552 trace2
("stderr is now $stderr\n================");
557 trace
("readwrite_gpg done.");
558 return ($stdout, $stderr, $status);
562 my ($question, $default, $forceyes, $forceno) = @_;
564 my $yn = $default ?
'[Y/n]' : '[y/N]';
566 print $question,' ',$yn, ' ';
567 if ($forceyes && $forceno) {
568 print "$default (from config/command line)\n";
572 print "YES (from config/command line)\n";
576 print "NO (from config/command line)\n";
581 if (!defined $answer) {
582 $OUTPUT_AUTOFLUSH = 1;
584 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
585 "so you can't really use it with xargs. A patch against caff to read from\n".
586 "the terminal would be appreciated.\n".
587 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
590 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
591 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
594 my $result = $default;
595 $result = 1 if $answer =~ /y/i;
596 $result = 0 if $answer =~ /n/i;
604 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
605 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
606 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
607 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
608 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
611 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
613 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
614 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
616 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
617 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
620 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
621 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
626 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
630 my ($fd, $exitcode) = @_;
632 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
633 print $fd "Consult the manual page for more information.\n";
638 # export key $keyid from $gnupghome
641 my ($gnupghome, $keyid) = @_;
643 my $gpg = GnuPG
::Interface
->new();
644 $gpg->call( $CONFIG{'gpg'} );
645 if (defined $gnupghome) {
646 $gpg->options->hash_init(
647 'homedir' => $gnupghome,
648 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
651 $gpg->options->hash_init(
652 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
655 $gpg->options->meta_interactive( 0 );
656 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
657 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
658 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
665 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
668 my ($gnupghome, $asciikey) = @_;
670 my $gpg = GnuPG
::Interface
->new();
671 $gpg->call( $CONFIG{'gpg'} );
672 $gpg->options->hash_init(
673 'homedir' => $gnupghome,
674 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
675 $gpg->options->meta_interactive( 0 );
676 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
677 my $pid = $gpg->import_keys(handles
=> $handles);
678 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
681 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
689 # Send an email to $address. If $can_encrypt is true then the mail
690 # will be PGP/MIME encrypted to $longkeyid.
692 # $longkeyid, $uid, and @attached will be used in the email and the template.
694 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
695 sub send_mail
($$$@
) {
696 my ($address, $can_encrypt, $key_id, @keys) = @_;
698 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
699 or die "Error creating template: $Text::Template::ERROR";
702 for my $key (@keys) {
703 push @uids, $key->{'text'};
705 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
707 owner
=> $CONFIG{'owner'}})
708 or die "Error filling template in: $Text::Template::ERROR";
710 my $message_entity = MIME
::Entity
->build(
711 Type
=> "text/plain",
713 Disposition
=> 'inline',
717 for my $key (@keys) {
718 $message_entity->attach(
719 Type
=> "application/pgp-keys",
720 Disposition
=> 'attachment',
722 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
723 Data
=> $key->{'key'},
724 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
728 my $message = $message_entity->stringify();
730 my $gpg = GnuPG
::Interface
->new();
731 $gpg->call( $CONFIG{'gpg'} );
732 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
733 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
735 $gpg->options->meta_interactive( 0 );
736 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
737 $gpg->options->push_recipients( $key_id );
738 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
739 my $pid = $gpg->encrypt(handles
=> $handles);
740 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
743 warn ("No data from gpg for list-key $key_id\n");
748 $message_entity = MIME
::Entity
->build(
749 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"',
752 $message_entity->attach(
753 Type
=> "application/pgp-encrypted",
754 Disposition
=> 'attachment',
756 Data
=> "Version: 1\n");
758 $message_entity->attach(
759 Type
=> "application/octet-stream",
760 Filename
=> 'msg.asc',
761 Disposition
=> 'inline',
766 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
767 $message_entity->head->add("To", $address);
768 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
769 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
770 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
771 $message_entity->head->add("User-Agent", $USER_AGENT);
772 $message_entity->send();
773 $message_entity->stringify();
777 # clean up a UID so that it can be used on the FS.
779 sub sanitize_uid
($) {
783 $good_uid =~ tr
#/:\\#_#;
784 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
788 sub delete_signatures
($$$$$$) {
789 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
791 my $signed_by_me = 0;
793 my ($stdout, $stderr, $status) =
794 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
796 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
797 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
798 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
799 $stdout =~ s/\n/\\n/g;
800 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
801 my $line = pop @sigline;
803 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
804 debug
("[sigremoval] doing line $line.");
805 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
806 if ($signer eq $longkeyid) {
807 debug
("[sigremoval] selfsig ($signer).");
809 } elsif (grep { $signer eq $_ } @
{$keyids}) {
810 debug
("[sigremoval] signed by us ($signer).");
812 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
814 debug
("[sigremoval] not interested in that sig ($signer).");
818 debug
("[sigremoval] no sig line here, only got: ".$stdout);
820 ($stdout, $stderr, $status) =
821 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
824 return $signed_by_me;
833 Getopt
::Long
::config
('bundling');
835 '-h' => \
$params->{'help'},
836 '--help' => \
$params->{'help'},
837 '--version' => \
$params->{'version'},
838 '-V' => \
$params->{'version'},
839 '-u=s' => \
$params->{'local-user'},
840 '--local-user=s' => \
$params->{'local-user'},
841 '-e' => \
$params->{'export-old'},
842 '--export-old' => \
$params->{'export-old'},
843 '-E' => \
$params->{'no-export-old'},
844 '--no-export-old' => \
$params->{'no-export-old'},
845 '-m' => \
$params->{'mail'},
846 '--mail' => \
$params->{'mail'},
847 '-M' => \
$params->{'no-mail'},
848 '--no-mail' => \
$params->{'no-mail'},
849 '-R' => \
$params->{'no-download'},
850 '--no-download' => \
$params->{'no-download'},
851 '-S' => \
$params->{'no-sign'},
852 '--no-sign' => \
$params->{'no-sign'},
853 '--key-file=s@' => \
$params->{'key-files'},
857 if ($params->{'help'}) {
860 if ($params->{'version'}) {
864 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
868 if ($params->{'local-user'}) {
869 $USER = $params->{'local-user'};
871 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
872 print STDERR
"-u $USER is not a keyid.\n";
878 for my $keyid (@ARGV) {
880 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
881 if ($keyid =~ /^[A-F0-9]{32}$/) {
882 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
885 print STDERR
"$keyid is not a keyid.\n";
888 push @KEYIDS, uc($keyid);
891 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
892 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
893 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
894 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
895 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
901 for my $keyid (@
{$CONFIG{'keyid'}}) {
902 my $gpg = GnuPG
::Interface
->new();
903 $gpg->call( $CONFIG{'gpg'} );
904 $gpg->options->hash_init(
905 'homedir' => $GNUPGHOME,
906 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
907 $gpg->options->meta_interactive( 0 );
908 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
909 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
910 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
914 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
916 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
917 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
918 my $key = export_key
(undef, $keyid);
919 if (!defined $key || $key eq '') {
920 warn ("Did not get key $keyid from your normal GnuPGHome\n");
923 my $result = import_key
($GNUPGHOME, $key);
925 warn ("Could not import $keyid into caff's gnupghome.\n");
931 ########################
932 # import keys from files
933 ########################
934 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
935 my $gpg = GnuPG
::Interface
->new();
936 $gpg->call( $CONFIG{'gpg'} );
937 $gpg->options->hash_init('homedir' => $GNUPGHOME);
938 $gpg->options->meta_interactive( 0 );
939 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
940 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
941 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
942 info
("Importing keys from $keyfile");
944 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
949 #############################
950 # receive keys from keyserver
951 #############################
953 if ($CONFIG{'no-download'}) {
954 @keyids_ok = @KEYIDS;
956 info
("fetching keys, this will take a while...");
958 my $gpg = GnuPG
::Interface
->new();
959 $gpg->call( $CONFIG{'gpg'} );
960 $gpg->options->hash_init(
961 'homedir' => $GNUPGHOME,
962 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
963 $gpg->options->meta_interactive( 0 );
964 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
965 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
966 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
969 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
972 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
973 my %local_keyids = map { $_ => 1 } @KEYIDS;
975 for my $line (split /\n/, $status) {
976 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
977 my $imported_key = $1;
978 my $whole_fpr = $imported_key;
979 my $long_keyid = substr($imported_key, -16);
980 my $short_keyid = substr($imported_key, -8);
982 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
983 $speced_key = $spec if $local_keyids{$spec};
985 unless ($speced_key) {
986 notice
("Imported unexpected key; got: $imported_key\n");
989 debug
("Imported $imported_key for $speced_key");
990 delete $local_keyids{$speced_key};
991 unshift @keyids_ok, $imported_key;
992 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
993 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
994 my $imported_key = $1;
995 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.");
998 notice
("got unknown reply from gpg: $line");
1001 if (scalar %local_keyids) {
1002 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
1003 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
1007 unless (@keyids_ok) {
1008 notice
("No keys to sign found");
1015 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1016 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
1019 unless ($CONFIG{'no-sign'}) {
1020 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1021 for my $keyid (@keyids_ok) {
1023 push @command, $CONFIG{'gpg-sign'};
1024 push @command, '--local-user', $USER if (defined $USER);
1025 push @command, "--homedir=$GNUPGHOME";
1026 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1027 push @command, '--no-auto-check-trustdb';
1028 push @command, '--trust-model=always';
1029 push @command, '--edit', $keyid;
1030 push @command, 'sign';
1031 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1032 print join(' ', @command),"\n";
1041 for my $keyid (@keyids_ok) {
1044 my $gpg = GnuPG
::Interface
->new();
1045 $gpg->call( $CONFIG{'gpg'} );
1046 $gpg->options->hash_init(
1047 'homedir' => $GNUPGHOME,
1048 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1049 $gpg->options->meta_interactive( 0 );
1050 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1051 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1052 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1054 if ($stdout eq '') {
1055 warn ("No data from gpg for list-key $keyid\n");
1058 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1059 if (scalar @publine == 0) {
1060 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1063 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1064 if (scalar @publine > 0) {
1065 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1068 unless (defined $longkeyid) {
1069 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1072 unless (defined $flags) {
1073 warn ("Didn't find flags in --list-key of key $keyid.\n");
1076 my $can_encrypt = $flags =~ /E/;
1080 my $asciikey = export_key
($GNUPGHOME, $keyid);
1081 if ($asciikey eq '') {
1082 warn ("No data from gpg for export $keyid\n");
1089 my $this_uid_text = '';
1091 debug
("Doing key $keyid, uid $uid_number");
1092 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1094 # import into temporary gpghome
1095 ###############################
1096 my $result = import_key
($tempdir, $asciikey);
1098 warn ("Could not import $keyid into temporary gnupg.\n");
1104 $gpg = GnuPG
::Interface
->new();
1105 $gpg->call( $CONFIG{'gpg-delsig'} );
1106 $gpg->options->hash_init(
1107 'homedir' => $tempdir,
1108 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1109 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1110 $pid = $gpg->wrap_call(
1111 commands
=> [ '--edit' ],
1112 command_args
=> [ $keyid ],
1113 handles
=> $handles );
1115 debug
("Starting edit session");
1116 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1120 my $number_of_subkeys = 0;
1124 my $delete_some = 0;
1125 debug
("Parsing stdout output.");
1126 for my $line (split /\n/, $stdout) {
1127 debug
("Checking line $line");
1128 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1129 if ($type eq 'sub') {
1130 $number_of_subkeys++;
1132 next unless ($type eq 'uid' || $type eq 'uat');
1133 debug
("line is interesting.");
1134 if ($uid_number != $i) {
1135 debug
("mark for deletion.");
1136 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1141 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1142 $is_uat = $type eq 'uat';
1146 debug
("Parsing stdout output done.");
1147 unless ($have_one) {
1148 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1149 info
("key $keyid done.");
1153 my $prune_some_sigs_on_uid;
1154 my $prune_all_sigs_on_uid;
1156 debug
("handling attribute userid of key $keyid.");
1157 if ($uid_number == 1) {
1158 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1159 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1161 $prune_some_sigs_on_uid = 1;
1162 $prune_all_sigs_on_uid = 2;
1164 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1165 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1167 $prune_some_sigs_on_uid = 2;
1168 $prune_all_sigs_on_uid = 1;
1171 $prune_some_sigs_on_uid = 1;
1175 debug
("need to delete $delete_some uids.");
1176 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1177 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1182 if ($number_of_subkeys > 0) {
1183 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1184 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1186 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1187 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1192 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1193 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1194 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1195 if (defined $prune_all_sigs_on_uid) {
1196 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1197 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1198 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1202 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1205 my $asciikey = export_key
($tempdir, $keyid);
1206 if ($asciikey eq '') {
1207 warn ("No data from gpg for export $keyid\n");
1211 if ($signed_by_me) {
1212 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1213 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1216 my $keydir = "$KEYSBASE/$DATE_STRING";
1217 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1219 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1220 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1221 print KEY
$asciikey;
1224 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1226 info
("$longkeyid $uid_number $this_uid_text done.");
1228 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1232 if (scalar @UIDS == 0) {
1233 info
("found no signed uids for $keyid");
1235 next if $CONFIG{'no-mail'}; # do not send mail
1238 for my $uid (@UIDS) {
1239 trace
("UID: $uid->{'text'}\n");
1240 if ($uid->{'is_uat'}) {
1241 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1242 push @attached, $uid if $attach;
1243 } elsif ($uid->{'text'} !~ /@/) {
1244 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1245 push @attached, $uid if $attach;
1249 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1250 for my $uid (@UIDS) {
1251 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1252 my $address = $uid->{'text'};
1253 $address =~ s/.*<(.*)>.*/$1/;
1254 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1255 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1257 my $keydir = "$KEYSBASE/$DATE_STRING";
1258 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1259 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");