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 die "Error: \$LOGNAME is not set.\n" unless $ENV{LOGNAME
};
312 my $gecos = (getpwnam($ENV{LOGNAME
}))[6];
315 my $gpg = GnuPG
::Interface
->new();
317 $gpg->options->hash_init(
318 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
319 $gpg->options->meta_interactive( 0 );
320 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
321 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
322 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
326 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
330 unless (@keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg)) {
331 die "Error: No keys were found using \"gpg --list-public-keys '$gecos'\".\n";
333 unless ($stdout =~ /^uid:.*<(.+@.+)>.*:/m) {
334 die "Error: No email address was found using \"gpg --list-public-keys '$gecos'\".\n";
339 # .caffrc -- vim:syntax=perl:
340 # This file is in perl(1) format - see caff(1) for details.
342 \$CONFIG{'owner'} = '$gecos';
343 \$CONFIG{'email'} = '$email';
345 # you can get your long keyid from
346 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
348 # if you have a v4 key, it will simply be the last 16 digits of
351 \$CONFIG{'keyid'} = [ qw{@keys} ];
356 my $config = $ENV{'HOME'} . '/.caffrc';
357 unless (-f
$config) {
358 print "No configfile $config present, I will use this template:\n";
359 my $template = generate_config
();
360 print "$template\nPlease edit $config and run caff again.\n";
361 open F
, ">$config" or die "$config: $!";
366 unless (scalar eval `cat $config`) {
367 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
370 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
371 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
372 die ("email is not defined.\n") unless defined $CONFIG{'email'};
373 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
374 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
375 for my $keyid (@
{$CONFIG{'keyid'}}) {
376 $keyid =~ /^[A-F0-9]{16}$/i or die ("key $keyid is not a long (16 digit) keyid.\n");
378 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
379 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
380 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
381 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
382 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
383 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
384 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
385 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
386 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
387 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
388 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
391 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
392 {foreach $uid (@uids) {
393 $OUT .= "\t".$uid."\n";
394 };} of your key {$key} signed by me.
396 Note that I did not upload your key to any keyservers.
397 If you have multiple user ids, I sent the signature for each user id
398 separately to that user id's associated email address. You can import
399 the signatures by running each through `gpg --import`.
401 If you want this new signature to be available to others, please upload
402 it yourself. With GnuPG this can be done using
403 gpg --keyserver subkeys.pgp.net --send-key {$key}
405 If you have any questions, don't hesitate to ask.
414 stdin
=> IO
::Handle
->new(),
415 stdout
=> IO
::Handle
->new(),
416 stderr
=> IO
::Handle
->new(),
417 status
=> IO
::Handle
->new() );
418 my $handles = GnuPG
::Handles
->new( %fds );
419 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
422 sub readwrite_gpg
($$$$$%) {
423 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
425 trace
("Entering readwrite_gpg.");
427 my ($first_line, undef) = split /\n/, $in;
428 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
430 local $INPUT_RECORD_SEPARATOR = undef;
431 my $sout = IO
::Select
->new();
432 my $sin = IO
::Select
->new();
435 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
437 $inputfd->blocking(0);
438 $stdoutfd->blocking(0);
439 $statusfd->blocking(0) if defined $statusfd;
440 $stderrfd->blocking(0);
441 $sout->add($stdoutfd);
442 $sout->add($stderrfd);
443 $sout->add($statusfd) if defined $statusfd;
446 my ($stdout, $stderr, $status) = ("", "", "");
447 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
448 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
450 my $readwrote_stuff_this_time = 0;
451 my $do_not_wait_on_select = 0;
452 my ($readyr, $readyw, $written);
453 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
454 if (defined $exitwhenstatusmatches) {
455 if ($status =~ /$exitwhenstatusmatches/m) {
456 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
457 if ($readwrote_stuff_this_time) {
458 trace
("read/write some more\n");
459 $do_not_wait_on_select = 1;
461 trace
("that's it in our while loop.\n");
467 $readwrote_stuff_this_time = 0;
468 trace
("select waiting for ".($sout->count())." fds.");
469 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
470 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
471 for my $wfd (@
$readyw) {
472 $readwrote_stuff_this_time = 1;
473 if (length($in) != $offset) {
474 trace
("writing to $wfd.");
475 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
478 if ($offset == length($in)) {
479 trace
("writing to $wfd done.");
480 unless ($options{'nocloseinput'}) {
482 trace
("$wfd closed.");
489 next unless (defined(@
$readyr)); # Wait some more.
491 for my $rfd (@
$readyr) {
492 $readwrote_stuff_this_time = 1;
494 trace
("reading from $rfd done.");
499 trace
("reading from $rfd.");
500 if ($rfd == $stdoutfd) {
502 trace2
("stdout is now $stdout\n================");
505 if (defined $statusfd && $rfd == $statusfd) {
507 trace2
("status is now $status\n================");
510 if ($rfd == $stderrfd) {
512 trace2
("stderr is now $stderr\n================");
517 trace
("readwrite_gpg done.");
518 return ($stdout, $stderr, $status);
522 my ($question, $default, $forceyes, $forceno) = @_;
524 my $yn = $default ?
'[Y/n]' : '[y/N]';
526 print $question,' ',$yn, ' ';
527 if ($forceyes && $forceno) {
528 print "$default (from config/command line)\n";
532 print "YES (from config/command line)\n";
536 print "NO (from config/command line)\n";
541 if (!defined $answer) {
542 $OUTPUT_AUTOFLUSH = 1;
544 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
545 "so you can't really use it with xargs. A patch against caff to read from\n".
546 "the terminal would be appreciated.\n".
547 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
550 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
551 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
554 my $result = $default;
555 $result = 1 if $answer =~ /y/i;
556 $result = 0 if $answer =~ /n/i;
564 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
565 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
566 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
567 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
568 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
571 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
573 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
574 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
576 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
577 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
580 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
581 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
586 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
590 my ($fd, $exitcode) = @_;
592 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
593 print $fd "Consult the manual page for more information.\n";
598 # export key $keyid from $gnupghome
601 my ($gnupghome, $keyid) = @_;
603 my $gpg = GnuPG
::Interface
->new();
604 $gpg->call( $CONFIG{'gpg'} );
605 if (defined $gnupghome) {
606 $gpg->options->hash_init(
607 'homedir' => $gnupghome,
608 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
611 $gpg->options->hash_init(
612 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
615 $gpg->options->meta_interactive( 0 );
616 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
617 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
618 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
625 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
628 my ($gnupghome, $asciikey) = @_;
630 my $gpg = GnuPG
::Interface
->new();
631 $gpg->call( $CONFIG{'gpg'} );
632 $gpg->options->hash_init(
633 'homedir' => $gnupghome,
634 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
635 $gpg->options->meta_interactive( 0 );
636 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
637 my $pid = $gpg->import_keys(handles
=> $handles);
638 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
641 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
649 # Send an email to $address. If $can_encrypt is true then the mail
650 # will be PGP/MIME encrypted to $longkeyid.
652 # $longkeyid, $uid, and @attached will be used in the email and the template.
654 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
655 sub send_mail
($$$@
) {
656 my ($address, $can_encrypt, $key_id, @keys) = @_;
658 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
659 or die "Error creating template: $Text::Template::ERROR";
662 for my $key (@keys) {
663 push @uids, $key->{'text'};
665 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
667 owner
=> $CONFIG{'owner'}})
668 or die "Error filling template in: $Text::Template::ERROR";
670 my $message_entity = MIME
::Entity
->build(
671 Type
=> "text/plain",
673 Disposition
=> 'inline',
677 for my $key (@keys) {
678 $message_entity->attach(
679 Type
=> "application/pgp-keys",
680 Disposition
=> 'attachment',
682 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
683 Data
=> $key->{'key'},
684 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
688 my $message = $message_entity->stringify();
690 my $gpg = GnuPG
::Interface
->new();
691 $gpg->call( $CONFIG{'gpg'} );
692 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
693 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
695 $gpg->options->meta_interactive( 0 );
696 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
697 $gpg->options->push_recipients( $key_id );
698 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
699 my $pid = $gpg->encrypt(handles
=> $handles);
700 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
703 warn ("No data from gpg for list-key $key_id\n");
708 $message_entity = MIME
::Entity
->build(
709 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"');
711 $message_entity->attach(
712 Type
=> "application/pgp-encrypted",
713 Disposition
=> 'attachment',
715 Data
=> "Version: 1\n");
717 $message_entity->attach(
718 Type
=> "application/octet-stream",
719 Filename
=> 'msg.asc',
720 Disposition
=> 'inline',
725 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
726 $message_entity->head->add("To", $address);
727 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
728 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
729 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
730 $message_entity->head->add("User-Agent", $USER_AGENT);
731 $message_entity->send();
732 $message_entity->stringify();
736 # clean up a UID so that it can be used on the FS.
738 sub sanitize_uid
($) {
742 $good_uid =~ tr
#/:\\#_#;
743 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
747 sub delete_signatures
($$$$$$) {
748 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
750 my $signed_by_me = 0;
752 my ($stdout, $stderr, $status) =
753 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
755 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
756 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
757 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
758 $stdout =~ s/\n/\\n/g;
759 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
760 my $line = pop @sigline;
762 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
763 debug
("[sigremoval] doing line $line.");
764 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
765 if ($signer eq $longkeyid) {
766 debug
("[sigremoval] selfsig ($signer).");
768 } elsif (grep { $signer eq $_ } @
{$keyids}) {
769 debug
("[sigremoval] signed by us ($signer).");
771 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
773 debug
("[sigremoval] not interested in that sig ($signer).");
777 debug
("[sigremoval] no sig line here, only got: ".$stdout);
779 ($stdout, $stderr, $status) =
780 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
783 return $signed_by_me;
792 Getopt
::Long
::config
('bundling');
794 '-h' => \
$params->{'help'},
795 '--help' => \
$params->{'help'},
796 '--version' => \
$params->{'version'},
797 '-V' => \
$params->{'version'},
798 '-u=s' => \
$params->{'local-user'},
799 '--local-user=s' => \
$params->{'local-user'},
800 '-e' => \
$params->{'export-old'},
801 '--export-old' => \
$params->{'export-old'},
802 '-E' => \
$params->{'no-export-old'},
803 '--no-export-old' => \
$params->{'no-export-old'},
804 '-m' => \
$params->{'mail'},
805 '--mail' => \
$params->{'mail'},
806 '-M' => \
$params->{'no-mail'},
807 '--no-mail' => \
$params->{'no-mail'},
808 '-R' => \
$params->{'no-download'},
809 '--no-download' => \
$params->{'no-download'},
810 '-S' => \
$params->{'no-sign'},
811 '--no-sign' => \
$params->{'no-sign'},
812 '--key-file=s@' => \
$params->{'key-files'},
816 if ($params->{'help'}) {
819 if ($params->{'version'}) {
823 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
827 if ($params->{'local-user'}) {
828 $USER = $params->{'local-user'};
830 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
831 print STDERR
"-u $USER is not a keyid.\n";
837 for my $keyid (@ARGV) {
839 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
840 if ($keyid =~ /^[A-F0-9]{32}$/) {
841 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
844 print STDERR
"$keyid is not a keyid.\n";
847 push @KEYIDS, uc($keyid);
850 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
851 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
852 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
853 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
854 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
860 for my $keyid (@
{$CONFIG{'keyid'}}) {
861 my $gpg = GnuPG
::Interface
->new();
862 $gpg->call( $CONFIG{'gpg'} );
863 $gpg->options->hash_init(
864 'homedir' => $GNUPGHOME,
865 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
866 $gpg->options->meta_interactive( 0 );
867 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
868 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
869 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
873 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
875 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
876 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
877 my $key = export_key
(undef, $keyid);
878 if (!defined $key || $key eq '') {
879 warn ("Did not get key $keyid from your normal GnuPGHome\n");
882 my $result = import_key
($GNUPGHOME, $key);
884 warn ("Could not import $keyid into caff's gnupghome.\n");
890 ########################
891 # import keys from files
892 ########################
893 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
894 my $gpg = GnuPG
::Interface
->new();
895 $gpg->call( $CONFIG{'gpg'} );
896 $gpg->options->hash_init('homedir' => $GNUPGHOME);
897 $gpg->options->meta_interactive( 0 );
898 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
899 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
900 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
901 info
("Importing keys from $keyfile");
903 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
908 #############################
909 # receive keys from keyserver
910 #############################
912 if ($CONFIG{'no-download'}) {
913 @keyids_ok = @KEYIDS;
915 info
("fetching keys, this will take a while...");
917 my $gpg = GnuPG
::Interface
->new();
918 $gpg->call( $CONFIG{'gpg'} );
919 $gpg->options->hash_init(
920 'homedir' => $GNUPGHOME,
921 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
922 $gpg->options->meta_interactive( 0 );
923 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
924 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
925 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
928 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
931 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
932 my %local_keyids = map { $_ => 1 } @KEYIDS;
934 for my $line (split /\n/, $status) {
935 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
936 my $imported_key = $1;
937 my $whole_fpr = $imported_key;
938 my $long_keyid = substr($imported_key, -16);
939 my $short_keyid = substr($imported_key, -8);
941 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
942 $speced_key = $spec if $local_keyids{$spec};
944 unless ($speced_key) {
945 notice
("Imported unexpected key; got: $imported_key\n");
948 debug
("Imported $imported_key for $speced_key");
949 delete $local_keyids{$speced_key};
950 unshift @keyids_ok, $imported_key;
951 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
952 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
953 my $imported_key = $1;
954 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.");
957 notice
("got unknown reply from gpg: $line");
960 if (scalar %local_keyids) {
961 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
962 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
966 unless (@keyids_ok) {
967 notice
("No keys to sign found");
974 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
975 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
978 unless ($CONFIG{'no-sign'}) {
979 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
980 for my $keyid (@keyids_ok) {
982 push @command, $CONFIG{'gpg-sign'};
983 push @command, '--local-user', $USER if (defined $USER);
984 push @command, "--homedir=$GNUPGHOME";
985 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
986 push @command, '--no-auto-check-trustdb';
987 push @command, '--trust-model=always';
988 push @command, '--edit', $keyid;
989 push @command, 'sign';
990 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
991 print join(' ', @command),"\n";
1000 for my $keyid (@keyids_ok) {
1003 my $gpg = GnuPG
::Interface
->new();
1004 $gpg->call( $CONFIG{'gpg'} );
1005 $gpg->options->hash_init(
1006 'homedir' => $GNUPGHOME,
1007 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1008 $gpg->options->meta_interactive( 0 );
1009 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1010 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1011 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1013 if ($stdout eq '') {
1014 warn ("No data from gpg for list-key $keyid\n");
1017 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1018 if (scalar @publine == 0) {
1019 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1022 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1023 if (scalar @publine > 0) {
1024 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1027 unless (defined $longkeyid) {
1028 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1031 unless (defined $flags) {
1032 warn ("Didn't find flags in --list-key of key $keyid.\n");
1035 my $can_encrypt = $flags =~ /E/;
1039 my $asciikey = export_key
($GNUPGHOME, $keyid);
1040 if ($asciikey eq '') {
1041 warn ("No data from gpg for export $keyid\n");
1048 my $this_uid_text = '';
1050 debug
("Doing key $keyid, uid $uid_number");
1051 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1053 # import into temporary gpghome
1054 ###############################
1055 my $result = import_key
($tempdir, $asciikey);
1057 warn ("Could not import $keyid into temporary gnupg.\n");
1063 $gpg = GnuPG
::Interface
->new();
1064 $gpg->call( $CONFIG{'gpg-delsig'} );
1065 $gpg->options->hash_init(
1066 'homedir' => $tempdir,
1067 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1068 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1069 $pid = $gpg->wrap_call(
1070 commands
=> [ '--edit' ],
1071 command_args
=> [ $keyid ],
1072 handles
=> $handles );
1074 debug
("Starting edit session");
1075 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1079 my $number_of_subkeys = 0;
1083 my $delete_some = 0;
1084 debug
("Parsing stdout output.");
1085 for my $line (split /\n/, $stdout) {
1086 debug
("Checking line $line");
1087 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1088 if ($type eq 'sub') {
1089 $number_of_subkeys++;
1091 next unless ($type eq 'uid' || $type eq 'uat');
1092 debug
("line is interesting.");
1093 if ($uid_number != $i) {
1094 debug
("mark for deletion.");
1095 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1100 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1101 $is_uat = $type eq 'uat';
1105 debug
("Parsing stdout output done.");
1106 unless ($have_one) {
1107 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1108 info
("key $keyid done.");
1112 my $prune_some_sigs_on_uid;
1113 my $prune_all_sigs_on_uid;
1115 debug
("handling attribute userid of key $keyid.");
1116 if ($uid_number == 1) {
1117 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1118 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1120 $prune_some_sigs_on_uid = 1;
1121 $prune_all_sigs_on_uid = 2;
1123 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1124 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1126 $prune_some_sigs_on_uid = 2;
1127 $prune_all_sigs_on_uid = 1;
1130 $prune_some_sigs_on_uid = 1;
1134 debug
("need to delete $delete_some uids.");
1135 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1136 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1141 if ($number_of_subkeys > 0) {
1142 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1143 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1145 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1146 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1151 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1152 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1153 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1154 if (defined $prune_all_sigs_on_uid) {
1155 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1156 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1157 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1161 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1164 my $asciikey = export_key
($tempdir, $keyid);
1165 if ($asciikey eq '') {
1166 warn ("No data from gpg for export $keyid\n");
1170 if ($signed_by_me) {
1171 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1172 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1175 my $keydir = "$KEYSBASE/$DATE_STRING";
1176 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1178 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1179 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1180 print KEY
$asciikey;
1183 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1185 info
("$longkeyid $uid_number $this_uid_text done.");
1187 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1191 if (scalar @UIDS == 0) {
1192 info
("found no signed uids for $keyid");
1194 next if $CONFIG{'no-mail'}; # do not send mail
1197 for my $uid (@UIDS) {
1198 trace
("UID: $uid->{'text'}\n");
1199 if ($uid->{'is_uat'}) {
1200 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1201 push @attached, $uid if $attach;
1202 } elsif ($uid->{'text'} !~ /@/) {
1203 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1204 push @attached, $uid if $attach;
1208 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1209 for my $uid (@UIDS) {
1210 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1211 my $address = $uid->{'text'};
1212 $address =~ s/.*<(.*)>.*/$1/;
1213 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1214 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1216 my $keydir = "$KEYSBASE/$DATE_STRING";
1217 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1218 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");