a804dbca3bcbbad5e2eac71b2b3d4f400491fb7e
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.
94 =item $HOME/.caffrc - configuration file
98 =head1 CONFIGURATION FILE OPTIONS
100 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
104 $CONFIG{owner} = q{Peter Palfrader};
105 $CONFIG{email} = q{peter@palfrader.org};
106 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
108 =head2 Required basic settings
112 =item B<owner> [string]
114 Your name. B<REQUIRED>.
116 =item B<email> [string]
118 Your email address, used in From: lines. B<REQUIRED>.
120 =item B<keyid> [list of keyids]
122 A list of your keys. This is used to determine which signatures to keep
123 in the pruning step. If you select a key using B<-u> it has to be in
124 this list. B<REQUIRED>.
126 =head2 General settings
128 =item B<caffhome> [string]
130 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
132 =head2 GnuPG settings
134 =item B<gpg> [string]
136 Path to the GnuPG binary. Default: B<gpg>.
138 =item B<gpg-sign> [string]
140 Path to the GnuPG binary which is used to sign keys. Default: what
143 =item B<gpg-delsig> [string]
145 Path to the GnuPG binary which is used to split off signatures. This was
146 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
149 =item B<secret-keyring> [string]
151 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
153 =item B<also-encrypt-to> [keyid]
155 An additional keyid to encrypt messages to. Default: none.
157 =item B<gpg-sign-args> [string]
159 Additional arguments to pass to gpg. Default: none.
161 =head2 Keyserver settings
163 =item B<keyserver> [string]
165 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
167 =item B<no-download> [boolean]
169 If true, then skip the step of fetching keys from the keyserver.
172 =head2 Signing settings
174 =item B<no-sign> [boolean]
176 If true, then skip the signing step. Default: B<0>.
178 =item B<ask-sign> [boolean]
180 If true, then pause before continuing to the signing step.
181 This is useful for offline signing. Default: B<0>.
183 =item B<export-sig-age> [seconds]
185 Don't export UIDs by default, on which your latest signature is older
186 than this age. Default: B<24*60*60> (i.e. one day).
190 =item B<mail> [boolean]
192 Do not prompt for sending mail, just do it. Default: B<0>.
194 =item B<no-mail> [boolean]
196 Do not prompt for sending mail. The messages are still written to
197 $CONFIG{caffhome}/keys/. Default: B<0>.
199 =item B<mail-template> [string]
201 Email template which is used as the body text for the email sent out
202 instead of the default text if specified. The following perl variables
203 can be used in the template:
207 =item B<{owner}> [string]
209 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
211 =item B<{key}> [string]
213 The keyid of the key you signed.
215 =item B<{@uids}> [array]
217 The UIDs for which signatures are included in the mail.
221 =item B<bcc> [string]
223 Address to send blind carbon copies to when sending mail.
232 =item Peter Palfrader <peter@palfrader.org>
234 =item Christoph Berg <cb@df7cb.de>
240 http://pgp-tools.alioth.debian.org/
248 use File
::Temp
qw{tempdir
};
254 use GnuPG
::Interface
;
257 my $REVISION = '$Rev$';
258 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
259 my $VERSION = "0.0.0.$REVISION_NUMER";
262 my $config = $ENV{'HOME'} . '/.caffrc';
263 -f
$config or die "No file $config present. See caff(1).\n";
264 unless (scalar eval `cat $config`) {
265 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
268 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
269 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
270 die ("email is not defined.\n") unless defined $CONFIG{'email'};
271 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
272 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
273 for my $keyid (@
{$CONFIG{'keyid'}}) {
274 $keyid =~ /^[A-F0-9]{16}$/i or die ("key $keyid is not a long (16 digit) keyid.\n");
276 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
277 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
278 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
279 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
280 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
281 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
282 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
283 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
284 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
285 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
288 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
289 {foreach $uid (@uids) {
290 $OUT .= "\t".$uid."\n";
291 };} of your key {$key} signed by me.
293 Note that I did not upload your key to any keyservers.
294 If you have multiple user ids, I sent the signature for each user id
295 separately to that user id's associated email address. You can import
296 the signatures by running each through `gpg --import`.
298 If you want this new signature to be available to others, please upload
299 it yourself. With GnuPG this can be done using
300 gpg --keyserver subkeys.pgp.net --send-key {$key}
302 If you have any questions, don't hesitate to ask.
311 print "[NOTICE] $line\n";
315 print "[INFO] $line\n";
319 #print "[DEBUG] $line\n";
323 #print "[trace] $line\n";
327 #print "[trace2] $line\n";
332 stdin
=> IO
::Handle
->new(),
333 stdout
=> IO
::Handle
->new(),
334 stderr
=> IO
::Handle
->new(),
335 status
=> IO
::Handle
->new() );
336 my $handles = GnuPG
::Handles
->new( %fds );
337 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
340 sub readwrite_gpg
($$$$$%) {
341 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
343 trace
("Entering readwrite_gpg.");
345 my ($first_line, undef) = split /\n/, $in;
346 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
348 local $INPUT_RECORD_SEPARATOR = undef;
349 my $sout = IO
::Select
->new();
350 my $sin = IO
::Select
->new();
353 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
355 $inputfd->blocking(0);
356 $stdoutfd->blocking(0);
357 $statusfd->blocking(0) if defined $statusfd;
358 $stderrfd->blocking(0);
359 $sout->add($stdoutfd);
360 $sout->add($stderrfd);
361 $sout->add($statusfd) if defined $statusfd;
364 my ($stdout, $stderr, $status) = ("", "", "");
365 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
366 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
368 my $readwrote_stuff_this_time = 0;
369 my $do_not_wait_on_select = 0;
370 my ($readyr, $readyw, $written);
371 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
372 if (defined $exitwhenstatusmatches) {
373 if ($status =~ /$exitwhenstatusmatches/m) {
374 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
375 if ($readwrote_stuff_this_time) {
376 trace
("read/write some more\n");
377 $do_not_wait_on_select = 1;
379 trace
("that's it in our while loop.\n");
385 $readwrote_stuff_this_time = 0;
386 trace
("select waiting for ".($sout->count())." fds.");
387 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
388 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
389 for my $wfd (@
$readyw) {
390 $readwrote_stuff_this_time = 1;
391 if (length($in) != $offset) {
392 trace
("writing to $wfd.");
393 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
396 if ($offset == length($in)) {
397 trace
("writing to $wfd done.");
398 unless ($options{'nocloseinput'}) {
400 trace
("$wfd closed.");
407 next unless (defined(@
$readyr)); # Wait some more.
409 for my $rfd (@
$readyr) {
410 $readwrote_stuff_this_time = 1;
412 trace
("reading from $rfd done.");
417 trace
("reading from $rfd.");
418 if ($rfd == $stdoutfd) {
420 trace2
("stdout is now $stdout\n================");
423 if (defined $statusfd && $rfd == $statusfd) {
425 trace2
("status is now $status\n================");
428 if ($rfd == $stderrfd) {
430 trace2
("stderr is now $stderr\n================");
435 trace
("readwrite_gpg done.");
436 return ($stdout, $stderr, $status);
440 my ($question, $default, $forceyes, $forceno) = @_;
441 return $default if $forceyes and $forceno;
442 return 1 if $forceyes;
443 return 0 if $forceno;
446 print $question,' ',($default ?
'[Y/n]' : '[y/N]'), ' ';
449 last if ((defined $answer) && (length $answer <= 1));
453 my $result = $default;
454 $result = 1 if $answer =~ /y/i;
455 $result = 0 if $answer =~ /n/i;
463 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
464 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
465 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
466 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
467 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
470 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
472 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
473 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
475 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
476 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
479 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
480 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
485 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
489 my ($fd, $exitcode) = @_;
491 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
492 print $fd "Consult the manual page for more information.\n";
497 # export key $keyid from $gnupghome
500 my ($gnupghome, $keyid) = @_;
502 my $gpg = GnuPG
::Interface
->new();
503 $gpg->call( $CONFIG{'gpg'} );
504 if (defined $gnupghome) {
505 $gpg->options->hash_init(
506 'homedir' => $gnupghome,
507 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
510 $gpg->options->hash_init(
511 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
514 $gpg->options->meta_interactive( 0 );
515 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
516 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
517 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
524 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
527 my ($gnupghome, $asciikey) = @_;
529 my $gpg = GnuPG
::Interface
->new();
530 $gpg->call( $CONFIG{'gpg'} );
531 $gpg->options->hash_init(
532 'homedir' => $gnupghome,
533 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
534 $gpg->options->meta_interactive( 0 );
535 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
536 my $pid = $gpg->import_keys(handles
=> $handles);
537 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
540 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
548 # Send an email to $address. If $can_encrypt is true then the mail
549 # will be PGP/MIME encrypted to $longkeyid.
551 # $longkeyid, $uid, and @attached will be used in the email and the template.
553 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
554 sub send_mail
($$$@
) {
555 my ($address, $can_encrypt, $key_id, @keys) = @_;
557 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
558 or die "Error creating template: $Text::Template::ERROR";
561 for my $key (@keys) {
562 push @uids, $key->{'text'};
564 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
566 owner
=> $CONFIG{'owner'}})
567 or die "Error filling template in: $Text::Template::ERROR";
569 my $message_entity = MIME
::Entity
->build(
570 Type
=> "text/plain",
572 Disposition
=> 'inline',
576 for my $key (@keys) {
577 $message_entity->attach(
578 Type
=> "application/pgp-keys",
579 Disposition
=> 'attachment',
581 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
582 Data
=> $key->{'key'},
583 Filename
=> "0x$key_id.".$key->{'serial'}.".asc");
587 my $message = $message_entity->stringify();
589 my $gpg = GnuPG
::Interface
->new();
590 $gpg->call( $CONFIG{'gpg'} );
591 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
592 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
594 $gpg->options->meta_interactive( 0 );
595 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
596 $gpg->options->push_recipients( $key_id );
597 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
598 my $pid = $gpg->encrypt(handles
=> $handles);
599 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
602 warn ("No data from gpg for list-key $key_id\n");
607 $message_entity = MIME
::Entity
->build(
608 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"');
610 $message_entity->attach(
611 Type
=> "application/pgp-encrypted",
612 Disposition
=> 'attachment',
614 Data
=> "Version: 1\n");
616 $message_entity->attach(
617 Type
=> "application/octet-stream",
618 Filename
=> 'msg.asc',
619 Disposition
=> 'inline',
624 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
625 $message_entity->head->add("To", $address);
626 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
627 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
628 $message_entity->head->add("User-Agent", $USER_AGENT);
629 $message_entity->send();
630 $message_entity->stringify();
634 # clean up a UID so that it can be used on the FS.
636 sub sanitize_uid
($) {
640 $good_uid =~ tr
#/:\\#_#;
641 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
645 sub delete_signatures
($$$$$$) {
646 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
648 my $signed_by_me = 0;
650 my ($stdout, $stderr, $status) =
651 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
653 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
654 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
655 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
656 $stdout =~ s/\n/\\n/g;
657 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
658 my $line = pop @sigline;
660 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
661 debug
("[sigremoval] doing line $line.");
662 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
663 if ($signer eq $longkeyid) {
664 debug
("[sigremoval] selfsig ($signer).");
666 } elsif (grep { $signer eq $_ } @
{$keyids}) {
667 debug
("[sigremoval] signed by us ($signer).");
669 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
671 debug
("[sigremoval] not interested in that sig ($signer).");
675 debug
("[sigremoval] no sig line here, only got: ".$stdout);
677 ($stdout, $stderr, $status) =
678 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
681 return $signed_by_me;
690 Getopt
::Long
::config
('bundling');
692 '-h' => \
$params->{'help'},
693 '--help' => \
$params->{'help'},
694 '--version' => \
$params->{'version'},
695 '-V' => \
$params->{'version'},
696 '-u=s' => \
$params->{'local-user'},
697 '--local-user=s' => \
$params->{'local-user'},
698 '-e' => \
$params->{'export-old'},
699 '--export-old' => \
$params->{'export-old'},
700 '-E' => \
$params->{'no-export-old'},
701 '--no-export-old' => \
$params->{'no-export-old'},
702 '-m' => \
$params->{'mail'},
703 '--mail' => \
$params->{'mail'},
704 '-M' => \
$params->{'no-mail'},
705 '--no-mail' => \
$params->{'no-mail'},
706 '-R' => \
$params->{'no-download'},
707 '--no-download' => \
$params->{'no-download'},
708 '-S' => \
$params->{'no-sign'},
709 '--no-sign' => \
$params->{'no-sign'},
713 if ($params->{'help'}) {
716 if ($params->{'version'}) {
720 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
724 if ($params->{'local-user'}) {
725 $USER = $params->{'local-user'};
727 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
728 print STDERR
"-u $USER is not a keyid.\n";
734 for my $keyid (@ARGV) {
736 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
737 if ($keyid =~ /^[A-F0-9]{32}$/) {
738 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
741 print STDERR
"$keyid is not a keyid.\n";
744 push @KEYIDS, uc($keyid);
747 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
748 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
749 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
750 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
756 for my $keyid (@
{$CONFIG{'keyid'}}) {
757 my $gpg = GnuPG
::Interface
->new();
758 $gpg->call( $CONFIG{'gpg'} );
759 $gpg->options->hash_init(
760 'homedir' => $GNUPGHOME,
761 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
762 $gpg->options->meta_interactive( 0 );
763 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
764 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
765 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
769 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
771 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
772 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
773 my $key = export_key
(undef, $keyid);
774 if (!defined $key || $key eq '') {
775 warn ("Did not get key $keyid from your normal GnuPGHome\n");
778 my $result = import_key
($GNUPGHOME, $key);
780 warn ("Could not import $keyid into caff's gnupghome.\n");
786 #############################
787 # receive keys from keyserver
788 #############################
790 if ($CONFIG{'no-download'}) {
791 @keyids_ok = @KEYIDS;
793 info
("fetching keys, this will take a while...");
795 my $gpg = GnuPG
::Interface
->new();
796 $gpg->call( $CONFIG{'gpg'} );
797 $gpg->options->hash_init(
798 'homedir' => $GNUPGHOME,
799 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
800 $gpg->options->meta_interactive( 0 );
801 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
802 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
803 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
806 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
809 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
810 my %local_keyids = map { $_ => 1 } @KEYIDS;
811 for my $line (split /\n/, $status) {
812 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
813 my $imported_key = $1;
814 my $whole_fpr = $imported_key;
815 my $long_keyid = substr($imported_key, -16);
816 my $short_keyid = substr($imported_key, -8);
818 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
819 $speced_key = $spec if $local_keyids{$spec};
821 unless ($speced_key) {
822 notice
("Imported unexpected key; got: $imported_key\n");
825 debug
("Imported $imported_key for $speced_key");
826 delete $local_keyids{$speced_key};
827 unshift @keyids_ok, $imported_key;
828 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
830 notice
("got unknown reply from gpg: $line");
833 if (scalar %local_keyids) {
834 notice
("Import failed for: ". (join ' ', keys %local_keyids).".");
835 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
839 unless (@keyids_ok) {
840 notice
("No keys to sign found");
847 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
848 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
851 unless ($CONFIG{'no-sign'}) {
852 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
853 for my $keyid (@keyids_ok) {
855 push @command, $CONFIG{'gpg-sign'};
856 push @command, '--local-user', $USER if (defined $USER);
857 push @command, "--homedir=$GNUPGHOME";
858 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
859 push @command, '--no-auto-check-trustdb';
860 push @command, '--trust-model=always';
861 push @command, '--edit', $keyid;
862 push @command, 'sign';
863 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
864 print join(' ', @command),"\n";
873 for my $keyid (@keyids_ok) {
876 my $gpg = GnuPG
::Interface
->new();
877 $gpg->call( $CONFIG{'gpg'} );
878 $gpg->options->hash_init(
879 'homedir' => $GNUPGHOME,
880 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
881 $gpg->options->meta_interactive( 0 );
882 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
883 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
884 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
887 warn ("No data from gpg for list-key $keyid\n");
890 my @publine = grep { /^pub/ } (split /\n/, $stdout);
891 if (scalar @publine == 0) {
892 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
895 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
896 if (scalar @publine > 0) {
897 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
900 unless (defined $longkeyid) {
901 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
904 unless (defined $flags) {
905 warn ("Didn't find flags in --list-key of key $keyid.\n");
908 my $can_encrypt = $flags =~ /E/;
912 my $asciikey = export_key
($GNUPGHOME, $keyid);
913 if ($asciikey eq '') {
914 warn ("No data from gpg for export $keyid\n");
921 my $this_uid_text = '';
923 debug
("Doing key $keyid, uid $uid_number");
924 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
926 # import into temporary gpghome
927 ###############################
928 my $result = import_key
($tempdir, $asciikey);
930 warn ("Could not import $keyid into temporary gnupg.\n");
936 $gpg = GnuPG
::Interface
->new();
937 $gpg->call( $CONFIG{'gpg-delsig'} );
938 $gpg->options->hash_init(
939 'homedir' => $tempdir,
940 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
941 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
942 $pid = $gpg->wrap_call(
943 commands
=> [ '--edit' ],
944 command_args
=> [ $keyid ],
945 handles
=> $handles );
947 debug
("Starting edit session");
948 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
952 my $number_of_subkeys = 0;
957 debug
("Parsing stdout output.");
958 for my $line (split /\n/, $stdout) {
959 debug
("Checking line $line");
960 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
961 if ($type eq 'sub') {
962 $number_of_subkeys++;
964 next unless ($type eq 'uid' || $type eq 'uat');
965 debug
("line is interesting.");
966 if ($uid_number != $i) {
967 debug
("mark for deletion.");
968 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
973 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
974 $is_uat = $type eq 'uat';
978 debug
("Parsing stdout output done.");
980 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
981 info
("key $keyid done.");
985 my $prune_some_sigs_on_uid;
986 my $prune_all_sigs_on_uid;
988 debug
("handling attribute userid of key $keyid.");
989 if ($uid_number == 1) {
990 debug
(" attribute userid is #1, unmarking #2 for deletion.");
991 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
993 $prune_some_sigs_on_uid = 1;
994 $prune_all_sigs_on_uid = 2;
996 debug
("attribute userid is not #1, unmarking #1 for deletion.");
997 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
999 $prune_some_sigs_on_uid = 2;
1000 $prune_all_sigs_on_uid = 1;
1003 $prune_some_sigs_on_uid = 1;
1007 debug
("need to delete $delete_some uids.");
1008 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1009 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1014 if ($number_of_subkeys > 0) {
1015 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1016 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1018 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1019 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1024 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1025 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1026 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1027 if (defined $prune_all_sigs_on_uid) {
1028 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1029 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1030 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1034 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1037 my $asciikey = export_key
($tempdir, $keyid);
1038 if ($asciikey eq '') {
1039 warn ("No data from gpg for export $keyid\n");
1043 if ($signed_by_me) {
1044 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1045 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1048 my $keydir = "$KEYSBASE/$DATE_STRING";
1049 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1051 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1052 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1053 print KEY
$asciikey;
1056 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1058 info
("$longkeyid $uid_number $this_uid_text done.");
1060 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1064 if (scalar @UIDS == 0) {
1065 info
("found no signed uids for $keyid");
1067 next if $CONFIG{'no-mail'}; # do not send mail
1070 for my $uid (@UIDS) {
1071 trace
("UID: $uid->{'text'}\n");
1072 if ($uid->{'is_uat'}) {
1073 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1074 push @attached, $uid if $attach;
1075 } elsif ($uid->{'text'} !~ /@/) {
1076 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1077 push @attached, $uid if $attach;
1081 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1082 for my $uid (@UIDS) {
1083 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1084 my $address = $uid->{'text'};
1085 $address =~ s/.*<(.*)>.*/$1/;
1086 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1087 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1089 my $keydir = "$KEYSBASE/$DATE_STRING";
1090 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1091 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");