8c9b105980562a015d85e79f23d26e7081306485
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/examples/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 if (defined $gecos) {
320 my $gpg = GnuPG
::Interface
->new();
322 $gpg->options->hash_init(
323 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
324 $gpg->options->meta_interactive( 0 );
325 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
326 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
327 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
331 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
334 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
335 unless (scalar @keys) {
336 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
337 @keys = qw{0123456789abcdef
89abcdef76543210
}
339 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
340 unless (defined $email) {
341 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
342 $email = $ENV{'LOGNAME'}.'@'.$hostname;
345 $gecos = 'Unknown Caff User';
346 $email = $ENV{'LOGNAME'}.'@'.$hostname;
347 @keys = qw{0123456789abcdef
89abcdef76543210
}
351 # .caffrc -- vim:syntax=perl:
352 # This file is in perl(1) format - see caff(1) for details.
354 \$CONFIG{'owner'} = '$gecos';
355 \$CONFIG{'email'} = '$email';
357 # you can get your long keyid from
358 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
360 # if you have a v4 key, it will simply be the last 16 digits of
364 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
365 # or, if you have more than one key:
366 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
368 \$CONFIG{'keyid'} = [ qw{@keys} ];
373 my $config = $ENV{'HOME'} . '/.caffrc';
374 unless (-f
$config) {
375 print "No configfile $config present, I will use this template:\n";
376 my $template = generate_config
();
377 print "$template\nPlease edit $config and run caff again.\n";
378 open F
, ">$config" or die "$config: $!";
383 unless (scalar eval `cat $config`) {
384 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
387 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
388 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
389 die ("email is not defined.\n") unless defined $CONFIG{'email'};
390 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
391 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
392 for my $keyid (@
{$CONFIG{'keyid'}}) {
393 $keyid =~ /^[A-F0-9]{16}$/i or die ("key $keyid is not a long (16 digit) keyid.\n");
395 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
396 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
397 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
398 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
399 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
400 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
401 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
402 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
403 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
404 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
405 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
408 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
409 {foreach $uid (@uids) {
410 $OUT .= "\t".$uid."\n";
411 };} of your key {$key} signed by me.
413 Note that I did not upload your key to any keyservers.
414 If you have multiple user ids, I sent the signature for each user id
415 separately to that user id's associated email address. You can import
416 the signatures by running each through `gpg --import`.
418 If you want this new signature to be available to others, please upload
419 it yourself. With GnuPG this can be done using
420 gpg --keyserver subkeys.pgp.net --send-key {$key}
422 If you have any questions, don't hesitate to ask.
431 stdin
=> IO
::Handle
->new(),
432 stdout
=> IO
::Handle
->new(),
433 stderr
=> IO
::Handle
->new(),
434 status
=> IO
::Handle
->new() );
435 my $handles = GnuPG
::Handles
->new( %fds );
436 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
439 sub readwrite_gpg
($$$$$%) {
440 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
442 trace
("Entering readwrite_gpg.");
444 my ($first_line, undef) = split /\n/, $in;
445 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
447 local $INPUT_RECORD_SEPARATOR = undef;
448 my $sout = IO
::Select
->new();
449 my $sin = IO
::Select
->new();
452 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
454 $inputfd->blocking(0);
455 $stdoutfd->blocking(0);
456 $statusfd->blocking(0) if defined $statusfd;
457 $stderrfd->blocking(0);
458 $sout->add($stdoutfd);
459 $sout->add($stderrfd);
460 $sout->add($statusfd) if defined $statusfd;
463 my ($stdout, $stderr, $status) = ("", "", "");
464 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
465 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
467 my $readwrote_stuff_this_time = 0;
468 my $do_not_wait_on_select = 0;
469 my ($readyr, $readyw, $written);
470 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
471 if (defined $exitwhenstatusmatches) {
472 if ($status =~ /$exitwhenstatusmatches/m) {
473 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
474 if ($readwrote_stuff_this_time) {
475 trace
("read/write some more\n");
476 $do_not_wait_on_select = 1;
478 trace
("that's it in our while loop.\n");
484 $readwrote_stuff_this_time = 0;
485 trace
("select waiting for ".($sout->count())." fds.");
486 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
487 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
488 for my $wfd (@
$readyw) {
489 $readwrote_stuff_this_time = 1;
490 if (length($in) != $offset) {
491 trace
("writing to $wfd.");
492 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
495 if ($offset == length($in)) {
496 trace
("writing to $wfd done.");
497 unless ($options{'nocloseinput'}) {
499 trace
("$wfd closed.");
506 next unless (defined(@
$readyr)); # Wait some more.
508 for my $rfd (@
$readyr) {
509 $readwrote_stuff_this_time = 1;
511 trace
("reading from $rfd done.");
516 trace
("reading from $rfd.");
517 if ($rfd == $stdoutfd) {
519 trace2
("stdout is now $stdout\n================");
522 if (defined $statusfd && $rfd == $statusfd) {
524 trace2
("status is now $status\n================");
527 if ($rfd == $stderrfd) {
529 trace2
("stderr is now $stderr\n================");
534 trace
("readwrite_gpg done.");
535 return ($stdout, $stderr, $status);
539 my ($question, $default, $forceyes, $forceno) = @_;
541 my $yn = $default ?
'[Y/n]' : '[y/N]';
543 print $question,' ',$yn, ' ';
544 if ($forceyes && $forceno) {
545 print "$default (from config/command line)\n";
549 print "YES (from config/command line)\n";
553 print "NO (from config/command line)\n";
558 if (!defined $answer) {
559 $OUTPUT_AUTOFLUSH = 1;
561 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
562 "so you can't really use it with xargs. A patch against caff to read from\n".
563 "the terminal would be appreciated.\n".
564 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
567 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
568 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
571 my $result = $default;
572 $result = 1 if $answer =~ /y/i;
573 $result = 0 if $answer =~ /n/i;
581 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
582 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
583 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
584 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
585 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
588 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
590 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
591 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
593 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
594 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
597 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
598 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
603 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
607 my ($fd, $exitcode) = @_;
609 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
610 print $fd "Consult the manual page for more information.\n";
615 # export key $keyid from $gnupghome
618 my ($gnupghome, $keyid) = @_;
620 my $gpg = GnuPG
::Interface
->new();
621 $gpg->call( $CONFIG{'gpg'} );
622 if (defined $gnupghome) {
623 $gpg->options->hash_init(
624 'homedir' => $gnupghome,
625 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
628 $gpg->options->hash_init(
629 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
632 $gpg->options->meta_interactive( 0 );
633 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
634 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
635 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
642 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
645 my ($gnupghome, $asciikey) = @_;
647 my $gpg = GnuPG
::Interface
->new();
648 $gpg->call( $CONFIG{'gpg'} );
649 $gpg->options->hash_init(
650 'homedir' => $gnupghome,
651 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
652 $gpg->options->meta_interactive( 0 );
653 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
654 my $pid = $gpg->import_keys(handles
=> $handles);
655 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
658 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
666 # Send an email to $address. If $can_encrypt is true then the mail
667 # will be PGP/MIME encrypted to $longkeyid.
669 # $longkeyid, $uid, and @attached will be used in the email and the template.
671 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
672 sub send_mail
($$$@
) {
673 my ($address, $can_encrypt, $key_id, @keys) = @_;
675 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
676 or die "Error creating template: $Text::Template::ERROR";
679 for my $key (@keys) {
680 push @uids, $key->{'text'};
682 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
684 owner
=> $CONFIG{'owner'}})
685 or die "Error filling template in: $Text::Template::ERROR";
687 my $message_entity = MIME
::Entity
->build(
688 Type
=> "text/plain",
690 Disposition
=> 'inline',
694 for my $key (@keys) {
695 $message_entity->attach(
696 Type
=> "application/pgp-keys",
697 Disposition
=> 'attachment',
699 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
700 Data
=> $key->{'key'},
701 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
705 my $message = $message_entity->stringify();
707 my $gpg = GnuPG
::Interface
->new();
708 $gpg->call( $CONFIG{'gpg'} );
709 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
710 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
712 $gpg->options->meta_interactive( 0 );
713 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
714 $gpg->options->push_recipients( $key_id );
715 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
716 my $pid = $gpg->encrypt(handles
=> $handles);
717 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
720 warn ("No data from gpg for list-key $key_id\n");
725 $message_entity = MIME
::Entity
->build(
726 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"');
728 $message_entity->attach(
729 Type
=> "application/pgp-encrypted",
730 Disposition
=> 'attachment',
732 Data
=> "Version: 1\n");
734 $message_entity->attach(
735 Type
=> "application/octet-stream",
736 Filename
=> 'msg.asc',
737 Disposition
=> 'inline',
742 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
743 $message_entity->head->add("To", $address);
744 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
745 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
746 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
747 $message_entity->head->add("User-Agent", $USER_AGENT);
748 $message_entity->send();
749 $message_entity->stringify();
753 # clean up a UID so that it can be used on the FS.
755 sub sanitize_uid
($) {
759 $good_uid =~ tr
#/:\\#_#;
760 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
764 sub delete_signatures
($$$$$$) {
765 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
767 my $signed_by_me = 0;
769 my ($stdout, $stderr, $status) =
770 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
772 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
773 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
774 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
775 $stdout =~ s/\n/\\n/g;
776 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
777 my $line = pop @sigline;
779 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
780 debug
("[sigremoval] doing line $line.");
781 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
782 if ($signer eq $longkeyid) {
783 debug
("[sigremoval] selfsig ($signer).");
785 } elsif (grep { $signer eq $_ } @
{$keyids}) {
786 debug
("[sigremoval] signed by us ($signer).");
788 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
790 debug
("[sigremoval] not interested in that sig ($signer).");
794 debug
("[sigremoval] no sig line here, only got: ".$stdout);
796 ($stdout, $stderr, $status) =
797 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
800 return $signed_by_me;
809 Getopt
::Long
::config
('bundling');
811 '-h' => \
$params->{'help'},
812 '--help' => \
$params->{'help'},
813 '--version' => \
$params->{'version'},
814 '-V' => \
$params->{'version'},
815 '-u=s' => \
$params->{'local-user'},
816 '--local-user=s' => \
$params->{'local-user'},
817 '-e' => \
$params->{'export-old'},
818 '--export-old' => \
$params->{'export-old'},
819 '-E' => \
$params->{'no-export-old'},
820 '--no-export-old' => \
$params->{'no-export-old'},
821 '-m' => \
$params->{'mail'},
822 '--mail' => \
$params->{'mail'},
823 '-M' => \
$params->{'no-mail'},
824 '--no-mail' => \
$params->{'no-mail'},
825 '-R' => \
$params->{'no-download'},
826 '--no-download' => \
$params->{'no-download'},
827 '-S' => \
$params->{'no-sign'},
828 '--no-sign' => \
$params->{'no-sign'},
829 '--key-file=s@' => \
$params->{'key-files'},
833 if ($params->{'help'}) {
836 if ($params->{'version'}) {
840 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
844 if ($params->{'local-user'}) {
845 $USER = $params->{'local-user'};
847 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
848 print STDERR
"-u $USER is not a keyid.\n";
854 for my $keyid (@ARGV) {
856 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
857 if ($keyid =~ /^[A-F0-9]{32}$/) {
858 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
861 print STDERR
"$keyid is not a keyid.\n";
864 push @KEYIDS, uc($keyid);
867 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
868 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
869 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
870 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
871 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
877 for my $keyid (@
{$CONFIG{'keyid'}}) {
878 my $gpg = GnuPG
::Interface
->new();
879 $gpg->call( $CONFIG{'gpg'} );
880 $gpg->options->hash_init(
881 'homedir' => $GNUPGHOME,
882 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
883 $gpg->options->meta_interactive( 0 );
884 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
885 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
886 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
890 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
892 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
893 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
894 my $key = export_key
(undef, $keyid);
895 if (!defined $key || $key eq '') {
896 warn ("Did not get key $keyid from your normal GnuPGHome\n");
899 my $result = import_key
($GNUPGHOME, $key);
901 warn ("Could not import $keyid into caff's gnupghome.\n");
907 ########################
908 # import keys from files
909 ########################
910 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
911 my $gpg = GnuPG
::Interface
->new();
912 $gpg->call( $CONFIG{'gpg'} );
913 $gpg->options->hash_init('homedir' => $GNUPGHOME);
914 $gpg->options->meta_interactive( 0 );
915 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
916 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
917 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
918 info
("Importing keys from $keyfile");
920 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
925 #############################
926 # receive keys from keyserver
927 #############################
929 if ($CONFIG{'no-download'}) {
930 @keyids_ok = @KEYIDS;
932 info
("fetching keys, this will take a while...");
934 my $gpg = GnuPG
::Interface
->new();
935 $gpg->call( $CONFIG{'gpg'} );
936 $gpg->options->hash_init(
937 'homedir' => $GNUPGHOME,
938 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
939 $gpg->options->meta_interactive( 0 );
940 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
941 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
942 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
945 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
948 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
949 my %local_keyids = map { $_ => 1 } @KEYIDS;
951 for my $line (split /\n/, $status) {
952 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
953 my $imported_key = $1;
954 my $whole_fpr = $imported_key;
955 my $long_keyid = substr($imported_key, -16);
956 my $short_keyid = substr($imported_key, -8);
958 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
959 $speced_key = $spec if $local_keyids{$spec};
961 unless ($speced_key) {
962 notice
("Imported unexpected key; got: $imported_key\n");
965 debug
("Imported $imported_key for $speced_key");
966 delete $local_keyids{$speced_key};
967 unshift @keyids_ok, $imported_key;
968 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
969 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
970 my $imported_key = $1;
971 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.");
974 notice
("got unknown reply from gpg: $line");
977 if (scalar %local_keyids) {
978 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
979 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
983 unless (@keyids_ok) {
984 notice
("No keys to sign found");
991 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
992 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
995 unless ($CONFIG{'no-sign'}) {
996 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
997 for my $keyid (@keyids_ok) {
999 push @command, $CONFIG{'gpg-sign'};
1000 push @command, '--local-user', $USER if (defined $USER);
1001 push @command, "--homedir=$GNUPGHOME";
1002 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1003 push @command, '--no-auto-check-trustdb';
1004 push @command, '--trust-model=always';
1005 push @command, '--edit', $keyid;
1006 push @command, 'sign';
1007 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1008 print join(' ', @command),"\n";
1017 for my $keyid (@keyids_ok) {
1020 my $gpg = GnuPG
::Interface
->new();
1021 $gpg->call( $CONFIG{'gpg'} );
1022 $gpg->options->hash_init(
1023 'homedir' => $GNUPGHOME,
1024 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1025 $gpg->options->meta_interactive( 0 );
1026 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1027 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1028 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1030 if ($stdout eq '') {
1031 warn ("No data from gpg for list-key $keyid\n");
1034 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1035 if (scalar @publine == 0) {
1036 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1039 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1040 if (scalar @publine > 0) {
1041 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1044 unless (defined $longkeyid) {
1045 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1048 unless (defined $flags) {
1049 warn ("Didn't find flags in --list-key of key $keyid.\n");
1052 my $can_encrypt = $flags =~ /E/;
1056 my $asciikey = export_key
($GNUPGHOME, $keyid);
1057 if ($asciikey eq '') {
1058 warn ("No data from gpg for export $keyid\n");
1065 my $this_uid_text = '';
1067 debug
("Doing key $keyid, uid $uid_number");
1068 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1070 # import into temporary gpghome
1071 ###############################
1072 my $result = import_key
($tempdir, $asciikey);
1074 warn ("Could not import $keyid into temporary gnupg.\n");
1080 $gpg = GnuPG
::Interface
->new();
1081 $gpg->call( $CONFIG{'gpg-delsig'} );
1082 $gpg->options->hash_init(
1083 'homedir' => $tempdir,
1084 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1085 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1086 $pid = $gpg->wrap_call(
1087 commands
=> [ '--edit' ],
1088 command_args
=> [ $keyid ],
1089 handles
=> $handles );
1091 debug
("Starting edit session");
1092 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1096 my $number_of_subkeys = 0;
1100 my $delete_some = 0;
1101 debug
("Parsing stdout output.");
1102 for my $line (split /\n/, $stdout) {
1103 debug
("Checking line $line");
1104 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1105 if ($type eq 'sub') {
1106 $number_of_subkeys++;
1108 next unless ($type eq 'uid' || $type eq 'uat');
1109 debug
("line is interesting.");
1110 if ($uid_number != $i) {
1111 debug
("mark for deletion.");
1112 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1117 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1118 $is_uat = $type eq 'uat';
1122 debug
("Parsing stdout output done.");
1123 unless ($have_one) {
1124 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1125 info
("key $keyid done.");
1129 my $prune_some_sigs_on_uid;
1130 my $prune_all_sigs_on_uid;
1132 debug
("handling attribute userid of key $keyid.");
1133 if ($uid_number == 1) {
1134 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1135 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1137 $prune_some_sigs_on_uid = 1;
1138 $prune_all_sigs_on_uid = 2;
1140 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1141 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1143 $prune_some_sigs_on_uid = 2;
1144 $prune_all_sigs_on_uid = 1;
1147 $prune_some_sigs_on_uid = 1;
1151 debug
("need to delete $delete_some uids.");
1152 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1153 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1158 if ($number_of_subkeys > 0) {
1159 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1160 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1162 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1163 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1168 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1169 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1170 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1171 if (defined $prune_all_sigs_on_uid) {
1172 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1173 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1174 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1178 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1181 my $asciikey = export_key
($tempdir, $keyid);
1182 if ($asciikey eq '') {
1183 warn ("No data from gpg for export $keyid\n");
1187 if ($signed_by_me) {
1188 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1189 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1192 my $keydir = "$KEYSBASE/$DATE_STRING";
1193 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1195 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1196 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1197 print KEY
$asciikey;
1200 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1202 info
("$longkeyid $uid_number $this_uid_text done.");
1204 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1208 if (scalar @UIDS == 0) {
1209 info
("found no signed uids for $keyid");
1211 next if $CONFIG{'no-mail'}; # do not send mail
1214 for my $uid (@UIDS) {
1215 trace
("UID: $uid->{'text'}\n");
1216 if ($uid->{'is_uat'}) {
1217 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1218 push @attached, $uid if $attach;
1219 } elsif ($uid->{'text'} !~ /@/) {
1220 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1221 push @attached, $uid if $attach;
1225 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1226 for my $uid (@UIDS) {
1227 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1228 my $address = $uid->{'text'};
1229 $address =~ s/.*<(.*)>.*/$1/;
1230 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1231 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1233 my $keydir = "$KEYSBASE/$DATE_STRING";
1234 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1235 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");