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 my ($Cgecos,$Cemail,$Ckeys) = ('','','');
318 if (defined $gecos) {
321 my $gpg = GnuPG
::Interface
->new();
323 $gpg->options->hash_init(
324 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
325 $gpg->options->meta_interactive( 0 );
326 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
327 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $gecos ]);
328 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
332 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
335 @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
336 unless (scalar @keys) {
337 info
("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
338 @keys = qw{0123456789abcdef
89abcdef76543210
};
341 ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
342 unless (defined $email) {
343 info
("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
344 $email = $ENV{'LOGNAME'}.'@'.$hostname;
348 $gecos = 'Unknown Caff User';
349 $email = $ENV{'LOGNAME'}.'@'.$hostname;
350 @keys = qw{0123456789abcdef
89abcdef76543210
};
351 ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
355 # .caffrc -- vim:syntax=perl:
356 # This file is in perl(1) format - see caff(1) for details.
358 $Cgecos\$CONFIG{'owner'} = '$gecos';
359 $Cemail\$CONFIG{'email'} = '$email';
361 # you can get your long keyid from
362 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
364 # if you have a v4 key, it will simply be the last 16 digits of
368 # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ];
369 # or, if you have more than one key:
370 # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
372 $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ];
377 my $config = $ENV{'HOME'} . '/.caffrc';
378 unless (-f
$config) {
379 print "No configfile $config present, I will use this template:\n";
380 my $template = generate_config
();
381 print "$template\nPlease edit $config and run caff again.\n";
382 open F
, ">$config" or die "$config: $!";
387 unless (scalar eval `cat $config`) {
388 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
391 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
392 die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
393 die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
394 die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
395 die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
396 for my $keyid (@
{$CONFIG{'keyid'}}) {
397 $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
399 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
400 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
401 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
402 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
403 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
404 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
405 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
406 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
407 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
408 $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
409 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
412 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
413 {foreach $uid (@uids) {
414 $OUT .= "\t".$uid."\n";
415 };} of your key {$key} signed by me.
417 Note that I did not upload your key to any keyservers.
418 If you have multiple user ids, I sent the signature for each user id
419 separately to that user id's associated email address. You can import
420 the signatures by running each through `gpg --import`.
422 If you want this new signature to be available to others, please upload
423 it yourself. With GnuPG this can be done using
424 gpg --keyserver subkeys.pgp.net --send-key {$key}
426 If you have any questions, don't hesitate to ask.
435 stdin
=> IO
::Handle
->new(),
436 stdout
=> IO
::Handle
->new(),
437 stderr
=> IO
::Handle
->new(),
438 status
=> IO
::Handle
->new() );
439 my $handles = GnuPG
::Handles
->new( %fds );
440 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
443 sub readwrite_gpg
($$$$$%) {
444 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
446 trace
("Entering readwrite_gpg.");
448 my ($first_line, undef) = split /\n/, $in;
449 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
451 local $INPUT_RECORD_SEPARATOR = undef;
452 my $sout = IO
::Select
->new();
453 my $sin = IO
::Select
->new();
456 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
458 $inputfd->blocking(0);
459 $stdoutfd->blocking(0);
460 $statusfd->blocking(0) if defined $statusfd;
461 $stderrfd->blocking(0);
462 $sout->add($stdoutfd);
463 $sout->add($stderrfd);
464 $sout->add($statusfd) if defined $statusfd;
467 my ($stdout, $stderr, $status) = ("", "", "");
468 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
469 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
471 my $readwrote_stuff_this_time = 0;
472 my $do_not_wait_on_select = 0;
473 my ($readyr, $readyw, $written);
474 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
475 if (defined $exitwhenstatusmatches) {
476 if ($status =~ /$exitwhenstatusmatches/m) {
477 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
478 if ($readwrote_stuff_this_time) {
479 trace
("read/write some more\n");
480 $do_not_wait_on_select = 1;
482 trace
("that's it in our while loop.\n");
488 $readwrote_stuff_this_time = 0;
489 trace
("select waiting for ".($sout->count())." fds.");
490 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
491 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
492 for my $wfd (@
$readyw) {
493 $readwrote_stuff_this_time = 1;
494 if (length($in) != $offset) {
495 trace
("writing to $wfd.");
496 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
499 if ($offset == length($in)) {
500 trace
("writing to $wfd done.");
501 unless ($options{'nocloseinput'}) {
503 trace
("$wfd closed.");
510 next unless (defined(@
$readyr)); # Wait some more.
512 for my $rfd (@
$readyr) {
513 $readwrote_stuff_this_time = 1;
515 trace
("reading from $rfd done.");
520 trace
("reading from $rfd.");
521 if ($rfd == $stdoutfd) {
523 trace2
("stdout is now $stdout\n================");
526 if (defined $statusfd && $rfd == $statusfd) {
528 trace2
("status is now $status\n================");
531 if ($rfd == $stderrfd) {
533 trace2
("stderr is now $stderr\n================");
538 trace
("readwrite_gpg done.");
539 return ($stdout, $stderr, $status);
543 my ($question, $default, $forceyes, $forceno) = @_;
545 my $yn = $default ?
'[Y/n]' : '[y/N]';
547 print $question,' ',$yn, ' ';
548 if ($forceyes && $forceno) {
549 print "$default (from config/command line)\n";
553 print "YES (from config/command line)\n";
557 print "NO (from config/command line)\n";
562 if (!defined $answer) {
563 $OUTPUT_AUTOFLUSH = 1;
565 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n".
566 "so you can't really use it with xargs. A patch against caff to read from\n".
567 "the terminal would be appreciated.\n".
568 "For now instead of cat keys | xargs caff do caff `cat keys`\n";
571 last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
572 print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
575 my $result = $default;
576 $result = 1 if $answer =~ /y/i;
577 $result = 0 if $answer =~ /n/i;
585 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
586 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
587 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
588 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
589 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
592 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
594 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
595 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
597 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
598 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
601 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
602 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
607 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
611 my ($fd, $exitcode) = @_;
613 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
614 print $fd "Consult the manual page for more information.\n";
619 # export key $keyid from $gnupghome
622 my ($gnupghome, $keyid) = @_;
624 my $gpg = GnuPG
::Interface
->new();
625 $gpg->call( $CONFIG{'gpg'} );
626 if (defined $gnupghome) {
627 $gpg->options->hash_init(
628 'homedir' => $gnupghome,
629 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
632 $gpg->options->hash_init(
633 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
636 $gpg->options->meta_interactive( 0 );
637 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
638 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
639 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
646 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
649 my ($gnupghome, $asciikey) = @_;
651 my $gpg = GnuPG
::Interface
->new();
652 $gpg->call( $CONFIG{'gpg'} );
653 $gpg->options->hash_init(
654 'homedir' => $gnupghome,
655 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ] );
656 $gpg->options->meta_interactive( 0 );
657 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
658 my $pid = $gpg->import_keys(handles
=> $handles);
659 my ($stdout, $stderr, $status) = readwrite_gpg
($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
662 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
670 # Send an email to $address. If $can_encrypt is true then the mail
671 # will be PGP/MIME encrypted to $longkeyid.
673 # $longkeyid, $uid, and @attached will be used in the email and the template.
675 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
676 sub send_mail
($$$@
) {
677 my ($address, $can_encrypt, $key_id, @keys) = @_;
679 my $template = Text
::Template
->new(TYPE
=> 'STRING', SOURCE
=> $CONFIG{'mail-template'})
680 or die "Error creating template: $Text::Template::ERROR";
683 for my $key (@keys) {
684 push @uids, $key->{'text'};
686 my $message = $template->fill_in(HASH
=> { key
=> $key_id,
688 owner
=> $CONFIG{'owner'}})
689 or die "Error filling template in: $Text::Template::ERROR";
691 my $message_entity = MIME
::Entity
->build(
692 Type
=> "text/plain",
694 Disposition
=> 'inline',
698 for my $key (@keys) {
699 $message_entity->attach(
700 Type
=> "application/pgp-keys",
701 Disposition
=> 'attachment',
703 Description
=> "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
704 Data
=> $key->{'key'},
705 Filename
=> "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
709 my $message = $message_entity->stringify();
711 my $gpg = GnuPG
::Interface
->new();
712 $gpg->call( $CONFIG{'gpg'} );
713 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
714 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
} ],
716 $gpg->options->meta_interactive( 0 );
717 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
718 $gpg->options->push_recipients( $key_id );
719 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
720 my $pid = $gpg->encrypt(handles
=> $handles);
721 my ($stdout, $stderr, $status) = readwrite_gpg
($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
724 warn ("No data from gpg for list-key $key_id\n");
729 $message_entity = MIME
::Entity
->build(
730 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"');
732 $message_entity->attach(
733 Type
=> "application/pgp-encrypted",
734 Disposition
=> 'attachment',
736 Data
=> "Version: 1\n");
738 $message_entity->attach(
739 Type
=> "application/octet-stream",
740 Filename
=> 'msg.asc',
741 Disposition
=> 'inline',
746 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
747 $message_entity->head->add("To", $address);
748 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
749 $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
750 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
751 $message_entity->head->add("User-Agent", $USER_AGENT);
752 $message_entity->send();
753 $message_entity->stringify();
757 # clean up a UID so that it can be used on the FS.
759 sub sanitize_uid
($) {
763 $good_uid =~ tr
#/:\\#_#;
764 trace2
("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
768 sub delete_signatures
($$$$$$) {
769 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
771 my $signed_by_me = 0;
773 my ($stdout, $stderr, $status) =
774 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
776 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
777 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
778 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
779 $stdout =~ s/\n/\\n/g;
780 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
781 my $line = pop @sigline;
783 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
784 debug
("[sigremoval] doing line $line.");
785 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
786 if ($signer eq $longkeyid) {
787 debug
("[sigremoval] selfsig ($signer).");
789 } elsif (grep { $signer eq $_ } @
{$keyids}) {
790 debug
("[sigremoval] signed by us ($signer).");
792 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created;
794 debug
("[sigremoval] not interested in that sig ($signer).");
798 debug
("[sigremoval] no sig line here, only got: ".$stdout);
800 ($stdout, $stderr, $status) =
801 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
804 return $signed_by_me;
813 Getopt
::Long
::config
('bundling');
815 '-h' => \
$params->{'help'},
816 '--help' => \
$params->{'help'},
817 '--version' => \
$params->{'version'},
818 '-V' => \
$params->{'version'},
819 '-u=s' => \
$params->{'local-user'},
820 '--local-user=s' => \
$params->{'local-user'},
821 '-e' => \
$params->{'export-old'},
822 '--export-old' => \
$params->{'export-old'},
823 '-E' => \
$params->{'no-export-old'},
824 '--no-export-old' => \
$params->{'no-export-old'},
825 '-m' => \
$params->{'mail'},
826 '--mail' => \
$params->{'mail'},
827 '-M' => \
$params->{'no-mail'},
828 '--no-mail' => \
$params->{'no-mail'},
829 '-R' => \
$params->{'no-download'},
830 '--no-download' => \
$params->{'no-download'},
831 '-S' => \
$params->{'no-sign'},
832 '--no-sign' => \
$params->{'no-sign'},
833 '--key-file=s@' => \
$params->{'key-files'},
837 if ($params->{'help'}) {
840 if ($params->{'version'}) {
844 usage
(\
*STDERR
, 1) unless scalar @ARGV >= 1;
848 if ($params->{'local-user'}) {
849 $USER = $params->{'local-user'};
851 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
852 print STDERR
"-u $USER is not a keyid.\n";
858 for my $keyid (@ARGV) {
860 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
861 if ($keyid =~ /^[A-F0-9]{32}$/) {
862 info
("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
865 print STDERR
"$keyid is not a keyid.\n";
868 push @KEYIDS, uc($keyid);
871 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
872 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
873 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
874 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
875 push @
{$CONFIG{'key-files'}}, @
{$params->{'key-files'}} if defined $params->{'key-files'};
881 for my $keyid (@
{$CONFIG{'keyid'}}) {
882 my $gpg = GnuPG
::Interface
->new();
883 $gpg->call( $CONFIG{'gpg'} );
884 $gpg->options->hash_init(
885 'homedir' => $GNUPGHOME,
886 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--fast
-list
-mode
} ] );
887 $gpg->options->meta_interactive( 0 );
888 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
889 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> $keyid);
890 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
894 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
896 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
897 info
("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
898 my $key = export_key
(undef, $keyid);
899 if (!defined $key || $key eq '') {
900 warn ("Did not get key $keyid from your normal GnuPGHome\n");
903 my $result = import_key
($GNUPGHOME, $key);
905 warn ("Could not import $keyid into caff's gnupghome.\n");
911 ########################
912 # import keys from files
913 ########################
914 foreach my $keyfile (@
{$CONFIG{'key-files'}}) {
915 my $gpg = GnuPG
::Interface
->new();
916 $gpg->call( $CONFIG{'gpg'} );
917 $gpg->options->hash_init('homedir' => $GNUPGHOME);
918 $gpg->options->meta_interactive( 0 );
919 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
920 my $pid = $gpg->import_keys(handles
=> $handles, command_args
=> $keyfile);
921 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
922 info
("Importing keys from $keyfile");
924 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
929 #############################
930 # receive keys from keyserver
931 #############################
933 if ($CONFIG{'no-download'}) {
934 @keyids_ok = @KEYIDS;
936 info
("fetching keys, this will take a while...");
938 my $gpg = GnuPG
::Interface
->new();
939 $gpg->call( $CONFIG{'gpg'} );
940 $gpg->options->hash_init(
941 'homedir' => $GNUPGHOME,
942 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
}, '--keyserver='.$CONFIG{'keyserver'} ] );
943 $gpg->options->meta_interactive( 0 );
944 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
945 my $pid = $gpg->recv_keys(handles
=> $handles, command_args
=> [ @KEYIDS ]);
946 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
949 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
952 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
953 my %local_keyids = map { $_ => 1 } @KEYIDS;
955 for my $line (split /\n/, $status) {
956 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
957 my $imported_key = $1;
958 my $whole_fpr = $imported_key;
959 my $long_keyid = substr($imported_key, -16);
960 my $short_keyid = substr($imported_key, -8);
962 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
963 $speced_key = $spec if $local_keyids{$spec};
965 unless ($speced_key) {
966 notice
("Imported unexpected key; got: $imported_key\n");
969 debug
("Imported $imported_key for $speced_key");
970 delete $local_keyids{$speced_key};
971 unshift @keyids_ok, $imported_key;
972 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
973 } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
974 my $imported_key = $1;
975 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.");
978 notice
("got unknown reply from gpg: $line");
981 if (scalar %local_keyids) {
982 notice
("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : ""));
983 exit 1 unless ask
("Some keys could not be imported - continue anyway?", 0);
987 unless (@keyids_ok) {
988 notice
("No keys to sign found");
995 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
996 $CONFIG{'no-sign'} = ! ask
("Continue with signing?", 1);
999 unless ($CONFIG{'no-sign'}) {
1000 info
("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1001 for my $keyid (@keyids_ok) {
1003 push @command, $CONFIG{'gpg-sign'};
1004 push @command, '--local-user', $USER if (defined $USER);
1005 push @command, "--homedir=$GNUPGHOME";
1006 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1007 push @command, '--no-auto-check-trustdb';
1008 push @command, '--trust-model=always';
1009 push @command, '--edit', $keyid;
1010 push @command, 'sign';
1011 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1012 print join(' ', @command),"\n";
1021 for my $keyid (@keyids_ok) {
1024 my $gpg = GnuPG
::Interface
->new();
1025 $gpg->call( $CONFIG{'gpg'} );
1026 $gpg->options->hash_init(
1027 'homedir' => $GNUPGHOME,
1028 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
} ] );
1029 $gpg->options->meta_interactive( 0 );
1030 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1031 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
1032 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
1034 if ($stdout eq '') {
1035 warn ("No data from gpg for list-key $keyid\n");
1038 my @publine = grep { /^pub/ } (split /\n/, $stdout);
1039 if (scalar @publine == 0) {
1040 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1043 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1044 if (scalar @publine > 0) {
1045 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
1048 unless (defined $longkeyid) {
1049 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
1052 unless (defined $flags) {
1053 warn ("Didn't find flags in --list-key of key $keyid.\n");
1056 my $can_encrypt = $flags =~ /E/;
1060 my $asciikey = export_key
($GNUPGHOME, $keyid);
1061 if ($asciikey eq '') {
1062 warn ("No data from gpg for export $keyid\n");
1069 my $this_uid_text = '';
1071 debug
("Doing key $keyid, uid $uid_number");
1072 my $tempdir = tempdir
( "caff-$keyid-XXXXX", DIR
=> '/tmp/', CLEANUP
=> 1);
1074 # import into temporary gpghome
1075 ###############################
1076 my $result = import_key
($tempdir, $asciikey);
1078 warn ("Could not import $keyid into temporary gnupg.\n");
1084 $gpg = GnuPG
::Interface
->new();
1085 $gpg->call( $CONFIG{'gpg-delsig'} );
1086 $gpg->options->hash_init(
1087 'homedir' => $tempdir,
1088 'extra_args' => [ qw{ --no-auto
-check
-trustdb
--trust
-model
=always
--with
-colons
--fixed
-list
-mode
--command
-fd
=0 --no-tty
} ] );
1089 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
1090 $pid = $gpg->wrap_call(
1091 commands
=> [ '--edit' ],
1092 command_args
=> [ $keyid ],
1093 handles
=> $handles );
1095 debug
("Starting edit session");
1096 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1100 my $number_of_subkeys = 0;
1104 my $delete_some = 0;
1105 debug
("Parsing stdout output.");
1106 for my $line (split /\n/, $stdout) {
1107 debug
("Checking line $line");
1108 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
1109 if ($type eq 'sub') {
1110 $number_of_subkeys++;
1112 next unless ($type eq 'uid' || $type eq 'uat');
1113 debug
("line is interesting.");
1114 if ($uid_number != $i) {
1115 debug
("mark for deletion.");
1116 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1121 $this_uid_text = ($type eq 'uid') ?
$uidtext : '[attribute]';
1122 $is_uat = $type eq 'uat';
1126 debug
("Parsing stdout output done.");
1127 unless ($have_one) {
1128 debug
("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1129 info
("key $keyid done.");
1133 my $prune_some_sigs_on_uid;
1134 my $prune_all_sigs_on_uid;
1136 debug
("handling attribute userid of key $keyid.");
1137 if ($uid_number == 1) {
1138 debug
(" attribute userid is #1, unmarking #2 for deletion.");
1139 readwrite_gpg
("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1141 $prune_some_sigs_on_uid = 1;
1142 $prune_all_sigs_on_uid = 2;
1144 debug
("attribute userid is not #1, unmarking #1 for deletion.");
1145 readwrite_gpg
("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1147 $prune_some_sigs_on_uid = 2;
1148 $prune_all_sigs_on_uid = 1;
1151 $prune_some_sigs_on_uid = 1;
1155 debug
("need to delete $delete_some uids.");
1156 readwrite_gpg
("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT, nocloseinput
=> 1);
1157 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1162 if ($number_of_subkeys > 0) {
1163 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1164 readwrite_gpg
("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1166 readwrite_gpg
("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput
=> 1);
1167 readwrite_gpg
("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
1172 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1173 my $signed_by_me = delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1174 readwrite_gpg
("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1175 if (defined $prune_all_sigs_on_uid) {
1176 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # mark uid for delsig
1177 delete_signatures
($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1178 readwrite_gpg
("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1); # unmark uid from delsig
1182 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1185 my $asciikey = export_key
($tempdir, $keyid);
1186 if ($asciikey eq '') {
1187 warn ("No data from gpg for export $keyid\n");
1191 if ($signed_by_me) {
1192 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1193 my $write = ask
("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1196 my $keydir = "$KEYSBASE/$DATE_STRING";
1197 -d
$keydir || mkpath
($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1199 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid
($this_uid_text).".asc";
1200 open (KEY
, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1201 print KEY
$asciikey;
1204 push @UIDS, { text
=> $this_uid_text, key
=> $asciikey, serial
=> $uid_number, "is_uat" => $is_uat };
1206 info
("$longkeyid $uid_number $this_uid_text done.");
1208 info
("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1212 if (scalar @UIDS == 0) {
1213 info
("found no signed uids for $keyid");
1215 next if $CONFIG{'no-mail'}; # do not send mail
1218 for my $uid (@UIDS) {
1219 trace
("UID: $uid->{'text'}\n");
1220 if ($uid->{'is_uat'}) {
1221 my $attach = ask
("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1222 push @attached, $uid if $attach;
1223 } elsif ($uid->{'text'} !~ /@/) {
1224 my $attach = ask
("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1225 push @attached, $uid if $attach;
1229 notice
("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1230 for my $uid (@UIDS) {
1231 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1232 my $address = $uid->{'text'};
1233 $address =~ s/.*<(.*)>.*/$1/;
1234 if (ask
("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1235 my $mail = send_mail
($address, $can_encrypt, $longkeyid, $uid, @attached);
1237 my $keydir = "$KEYSBASE/$DATE_STRING";
1238 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid
($uid->{'text'});
1239 open (KEY
, ">$mailfile") or die ("Cannot open $mailfile: $!\n");