]> git.sthu.org Git - pgp-tools.git/blob - caff/caff
014b8387e0176502583e93bda60964e0ba1dd350
[pgp-tools.git] / caff / caff
1 #!/usr/bin/perl -w
2
3 # caff -- CA - Fire and Forget
4 # $Id$
5 #
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 # Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
8 #
9 # All rights reserved.
10 #
11 # Redistribution and use in source and binary forms, with or without
12 # modification, are permitted provided that the following conditions
13 # are met:
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.
21 #
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.
32
33 =pod
34
35 =head1 NAME
36
37 caff -- CA - Fire and Forget
38
39 =head1 SYNOPSIS
40
41 =over
42
43 =item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
44
45 =back
46
47 =head1 DESCRIPTION
48
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.
54
55 =head1 OPTIONS
56
57 =over
58
59 =item B<-e>, B<--export-old>
60
61 Export old signatures. Default is to ask the user for each old signature.
62
63 =item B<-E>, B<--no-export-old>
64
65 Do not export old signatures. Default is to ask the user for each old
66 signature.
67
68 =item B<-m>, B<--mail>
69
70 Send mail after signing. Default is to ask the user for each uid.
71
72 =item B<-M>, B<--no-mail>
73
74 Do not send mail after signing. Default is to ask the user for each uid.
75
76 =item B<-R>, B<--no-download>
77
78 Do not retrieve the key to be signed from a keyserver.
79
80 =item B<-S>, B<--no-sign>
81
82 Do not sign the keys.
83
84 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
85
86 Select the key that is used for signing, in case you have more than one key.
87
88 =back
89
90 =head1 FILES
91
92 =over
93
94 =item $HOME/.caffrc - configuration file
95
96 =back
97
98 =head1 CONFIGURATION FILE OPTIONS
99
100 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
101
102 Example:
103
104 $CONFIG{owner} = q{Peter Palfrader};
105 $CONFIG{email} = q{peter@palfrader.org};
106 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
107
108 =head2 Required basic settings
109
110 =over
111
112 =item B<owner> [string]
113
114 Your name. B<REQUIRED>.
115
116 =item B<email> [string]
117
118 Your email address, used in From: lines. B<REQUIRED>.
119
120 =item B<keyid> [list of keyids]
121
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>.
125
126 =head2 General settings
127
128 =item B<caffhome> [string]
129
130 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
131
132 =head2 GnuPG settings
133
134 =item B<gpg> [string]
135
136 Path to the GnuPG binary. Default: B<gpg>.
137
138 =item B<gpg-sign> [string]
139
140 Path to the GnuPG binary which is used to sign keys. Default: what
141 B<gpg> is set to.
142
143 =item B<gpg-delsig> [string]
144
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>
147 is set to.
148
149 =item B<secret-keyring> [string]
150
151 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
152
153 =item B<also-encrypt-to> [keyid]
154
155 An additional keyid to encrypt messages to. Default: none.
156
157 =item B<gpg-sign-args> [string]
158
159 Additional arguments to pass to gpg. Default: none.
160
161 =head2 Keyserver settings
162
163 =item B<keyserver> [string]
164
165 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
166
167 =item B<no-download> [boolean]
168
169 If true, then skip the step of fetching keys from the keyserver.
170 Default: B<0>.
171
172 =head2 Signing settings
173
174 =item B<no-sign> [boolean]
175
176 If true, then skip the signing step. Default: B<0>.
177
178 =item B<ask-sign> [boolean]
179
180 If true, then pause before continuing to the signing step.
181 This is useful for offline signing. Default: B<0>.
182
183 =item B<export-sig-age> [seconds]
184
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).
187
188 =head2 Mail settings
189
190 =item B<mail> [boolean]
191
192 Do not prompt for sending mail, just do it. Default: B<0>.
193
194 =item B<no-mail> [boolean]
195
196 Do not prompt for sending mail. The messages are still written to
197 $CONFIG{caffhome}/keys/. Default: B<0>.
198
199 =item B<mail-template> [string]
200
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:
204
205 =over
206
207 =item B<{owner}> [string]
208
209 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
210
211 =item B<{key}> [string]
212
213 The keyid of the key you signed.
214
215 =item B<{@uids}> [array]
216
217 The UIDs for which signatures are included in the mail.
218
219 =back
220
221 =item B<bcc> [string]
222
223 Address to send blind carbon copies to when sending mail.
224 Default: none.
225
226 =back
227
228 =head1 AUTHORS
229
230 =over
231
232 =item Peter Palfrader <peter@palfrader.org>
233
234 =item Christoph Berg <cb@df7cb.de>
235
236 =back
237
238 =head1 WEBSITE
239
240 http://pgp-tools.alioth.debian.org/
241
242 =cut
243
244 use strict;
245 use IO::Handle;
246 use English;
247 use File::Path;
248 use File::Temp qw{tempdir};
249 use Text::Template;
250 use MIME::Entity;
251 use Fcntl;
252 use IO::Select;
253 use Getopt::Long;
254 use GnuPG::Interface;
255
256 my %CONFIG;
257 my $REVISION = '$Rev$';
258 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
259 my $VERSION = "0.0.0.$REVISION_NUMER";
260
261 sub load_config() {
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;
266 };
267
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");
275 };
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'};
286 Hi,
287
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.
292
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`.
297
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}
301
302 If you have any questions, don't hesitate to ask.
303
304 Regards,
305 {$owner}
306 EOM
307 };
308
309 sub notice($) {
310 my ($line) = @_;
311 print "[NOTICE] $line\n";
312 };
313 sub info($) {
314 my ($line) = @_;
315 print "[INFO] $line\n";
316 };
317 sub debug($) {
318 my ($line) = @_;
319 #print "[DEBUG] $line\n";
320 };
321 sub trace($) {
322 my ($line) = @_;
323 #print "[trace] $line\n";
324 };
325 sub trace2($) {
326 my ($line) = @_;
327 #print "[trace2] $line\n";
328 };
329
330 sub make_gpg_fds() {
331 my %fds = (
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);
338 };
339
340 sub readwrite_gpg($$$$$%) {
341 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
342
343 trace("Entering readwrite_gpg.");
344
345 my ($first_line, undef) = split /\n/, $in;
346 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
347
348 local $INPUT_RECORD_SEPARATOR = undef;
349 my $sout = IO::Select->new();
350 my $sin = IO::Select->new();
351 my $offset = 0;
352
353 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
354
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;
362 $sin->add($inputfd);
363
364 my ($stdout, $stderr, $status) = ("", "", "");
365 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
366 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
367
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;
378 } else {
379 trace("that's it in our while loop.\n");
380 last;
381 }
382 };
383 };
384
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);
394 $offset += $written;
395 };
396 if ($offset == length($in)) {
397 trace("writing to $wfd done.");
398 unless ($options{'nocloseinput'}) {
399 close $wfd;
400 trace("$wfd closed.");
401 };
402 $sin->remove($wfd);
403 $sin = undef;
404 }
405 }
406
407 next unless (defined(@$readyr)); # Wait some more.
408
409 for my $rfd (@$readyr) {
410 $readwrote_stuff_this_time = 1;
411 if ($rfd->eof) {
412 trace("reading from $rfd done.");
413 $sout->remove($rfd);
414 close($rfd);
415 next;
416 }
417 trace("reading from $rfd.");
418 if ($rfd == $stdoutfd) {
419 $stdout .= <$rfd>;
420 trace2("stdout is now $stdout\n================");
421 next;
422 }
423 if (defined $statusfd && $rfd == $statusfd) {
424 $status .= <$rfd>;
425 trace2("status is now $status\n================");
426 next;
427 }
428 if ($rfd == $stderrfd) {
429 $stderr .= <$rfd>;
430 trace2("stderr is now $stderr\n================");
431 next;
432 }
433 }
434 }
435 trace("readwrite_gpg done.");
436 return ($stdout, $stderr, $status);
437 };
438
439 sub ask($$;$$) {
440 my ($question, $default, $forceyes, $forceno) = @_;
441 return $default if $forceyes and $forceno;
442 return 1 if $forceyes;
443 return 0 if $forceno;
444 my $answer;
445 while (1) {
446 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
447 $answer = <STDIN>;
448 chomp $answer;
449 last if ((defined $answer) && (length $answer <= 1));
450 print "grrrrrr.\n";
451 sleep 1;
452 };
453 my $result = $default;
454 $result = 1 if $answer =~ /y/i;
455 $result = 0 if $answer =~ /n/i;
456 return $result;
457 };
458
459
460
461
462
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';
468
469 load_config;
470 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
471
472 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
473 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
474
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");
477
478 my $NOW = time;
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);
481
482
483 sub version($) {
484 my ($fd) = @_;
485 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
486 };
487
488 sub usage($$) {
489 my ($fd, $exitcode) = @_;
490 version($fd);
491 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
492 print $fd "Consult the manual page for more information.\n";
493 exit $exitcode;
494 };
495
496 ######
497 # export key $keyid from $gnupghome
498 ######
499 sub export_key($$) {
500 my ($gnupghome, $keyid) = @_;
501
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 } ],
508 'armor' => 1 );
509 } else {
510 $gpg->options->hash_init(
511 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
512 'armor' => 1 );
513 };
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);
518 waitpid $pid, 0;
519
520 return $stdout;
521 };
522
523 ######
524 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
525 ######
526 sub import_key($$) {
527 my ($gnupghome, $asciikey) = @_;
528
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);
538 waitpid $pid, 0;
539
540 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
541 return undef;
542 };
543 return 1;
544 };
545
546
547 ######
548 # Send an email to $address. If $can_encrypt is true then the mail
549 # will be PGP/MIME encrypted to $longkeyid.
550 #
551 # $longkeyid, $uid, and @attached will be used in the email and the template.
552 ######
553 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
554 sub send_mail($$$@) {
555 my ($address, $can_encrypt, $key_id, @keys) = @_;
556
557 my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
558 or die "Error creating template: $Text::Template::ERROR";
559
560 my @uids;
561 for my $key (@keys) {
562 push @uids, $key->{'text'};
563 };
564 my $message = $template->fill_in(HASH => { key => $key_id,
565 uids => \@uids,
566 owner => $CONFIG{'owner'}})
567 or die "Error filling template in: $Text::Template::ERROR";
568
569 my $message_entity = MIME::Entity->build(
570 Type => "text/plain",
571 Charset => "utf-8",
572 Disposition => 'inline',
573 Data => $message);
574
575 my @key_entities;
576 for my $key (@keys) {
577 $message_entity->attach(
578 Type => "application/pgp-keys",
579 Disposition => 'attachment',
580 Encoding => "7bit",
581 Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
582 Data => $key->{'key'},
583 Filename => "0x$key_id.".$key->{'serial'}.".asc");
584 };
585
586 if ($can_encrypt) {
587 my $message = $message_entity->stringify();
588
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 } ],
593 'armor' => 1 );
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);
600 waitpid $pid, 0;
601 if ($stdout eq '') {
602 warn ("No data from gpg for list-key $key_id\n");
603 next;
604 };
605 $message = $stdout;
606
607 $message_entity = MIME::Entity->build(
608 Type => 'multipart/encrypted; protocol="application/pgp-encrypted"');
609
610 $message_entity->attach(
611 Type => "application/pgp-encrypted",
612 Disposition => 'attachment',
613 Encoding => "7bit",
614 Data => "Version: 1\n");
615
616 $message_entity->attach(
617 Type => "application/octet-stream",
618 Filename => 'msg.asc',
619 Disposition => 'inline',
620 Encoding => "7bit",
621 Data => $message);
622 };
623
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();
631 };
632
633 ######
634 # clean up a UID so that it can be used on the FS.
635 ######
636 sub sanitize_uid($) {
637 my ($uid) = @_;
638
639 my $good_uid = $uid;
640 $good_uid =~ tr#/:\\#_#;
641 trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
642 return $good_uid;
643 };
644
645 sub delete_signatures($$$$$$) {
646 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
647
648 my $signed_by_me = 0;
649
650 my ($stdout, $stderr, $status) =
651 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
652
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;
659 my $answer = "no";
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).");
665 $answer = "no";
666 } elsif (grep { $signer eq $_ } @{$keyids}) {
667 debug("[sigremoval] signed by us ($signer).");
668 $answer = "no";
669 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
670 } else {
671 debug("[sigremoval] not interested in that sig ($signer).");
672 $answer = "yes";
673 };
674 } else {
675 debug("[sigremoval] no sig line here, only got: ".$stdout);
676 };
677 ($stdout, $stderr, $status) =
678 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
679 };
680
681 return $signed_by_me;
682 };
683
684
685
686 my $USER;
687 my @KEYIDS;
688 my $params;
689
690 Getopt::Long::config('bundling');
691 if (!GetOptions (
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'},
710 )) {
711 usage(\*STDERR, 1);
712 };
713 if ($params->{'help'}) {
714 usage(\*STDOUT, 0);
715 };
716 if ($params->{'version'}) {
717 version(\*STDOUT);
718 exit(0);
719 };
720 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
721
722
723
724 if ($params->{'local-user'}) {
725 $USER = $params->{'local-user'};
726 $USER =~ s/^0x//i;
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";
729 usage(\*STDERR, 1);
730 };
731 $USER = uc($USER);
732 };
733
734 for my $keyid (@ARGV) {
735 $keyid =~ s/^0x//i;
736 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
737 print STDERR "$keyid is not a keyid.\n";
738 usage(\*STDERR, 1);
739 };
740 push @KEYIDS, uc($keyid);
741 };
742
743 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
744 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
745 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
746 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
747
748
749 #################
750 # import own keys
751 #################
752 for my $keyid (@{$CONFIG{'keyid'}}) {
753 my $gpg = GnuPG::Interface->new();
754 $gpg->call( $CONFIG{'gpg'} );
755 $gpg->options->hash_init(
756 'homedir' => $GNUPGHOME,
757 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --fast-list-mode } ] );
758 $gpg->options->meta_interactive( 0 );
759 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
760 my $pid = $gpg->list_public_keys(handles => $handles, command_args => $keyid);
761 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
762 waitpid $pid, 0;
763
764 if ($stdout eq '') {
765 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
766 };
767 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
768 info("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
769 my $key = export_key(undef, $keyid);
770 if (!defined $key || $key eq '') {
771 warn ("Did not get key $keyid from your normal GnuPGHome\n");
772 next;
773 };
774 my $result = import_key($GNUPGHOME, $key);
775 unless ($result) {
776 warn ("Could not import $keyid into caff's gnupghome.\n");
777 next;
778 };
779 }
780 }
781
782 #############################
783 # receive keys from keyserver
784 #############################
785 my @keyids_ok;
786 if ($CONFIG{'no-download'}) {
787 @keyids_ok = @KEYIDS;
788 } else {
789 info ("fetching keys, this will take a while...");
790
791 my $gpg = GnuPG::Interface->new();
792 $gpg->call( $CONFIG{'gpg'} );
793 $gpg->options->hash_init(
794 'homedir' => $GNUPGHOME,
795 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
796 $gpg->options->meta_interactive( 0 );
797 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
798 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
799 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
800 waitpid $pid, 0;
801
802 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
803 # [GNUPG:] NODATA 1
804 # [GNUPG:] NODATA 1
805 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
806 my %local_keyids = map { $_ => 1 } @KEYIDS;
807 for my $line (split /\n/, $status) {
808 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
809 my $imported_key = $1;
810 my $whole_fpr = $imported_key;
811 my $long_keyid = substr($imported_key, -16);
812 my $short_keyid = substr($imported_key, -8);
813 my $speced_key;
814 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
815 $speced_key = $spec if $local_keyids{$spec};
816 };
817 unless ($speced_key) {
818 notice ("Imported unexpected key; got: $imported_key\n");
819 next;
820 };
821 debug ("Imported $imported_key for $speced_key");
822 delete $local_keyids{$speced_key};
823 unshift @keyids_ok, $imported_key;
824 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
825 } else {
826 notice ("got unknown reply from gpg: $line");
827 }
828 };
829 if (scalar %local_keyids) {
830 notice ("Import failed for: ". (join ' ', keys %local_keyids).".");
831 exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
832 }
833 };
834
835 unless (@keyids_ok) {
836 notice ("No keys to sign found");
837 exit 0;
838 }
839
840 ###########
841 # sign keys
842 ###########
843 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
844 $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
845 }
846
847 unless ($CONFIG{'no-sign'}) {
848 info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
849 for my $keyid (@keyids_ok) {
850 my @command;
851 push @command, $CONFIG{'gpg-sign'};
852 push @command, '--local-user', $USER if (defined $USER);
853 push @command, "--homedir=$GNUPGHOME";
854 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
855 push @command, '--no-auto-check-trustdb';
856 push @command, '--trust-model=always';
857 push @command, '--edit', $keyid;
858 push @command, 'sign';
859 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
860 print join(' ', @command),"\n";
861 system (@command);
862 };
863 };
864
865 ##################
866 # export and prune
867 ##################
868 KEYS:
869 for my $keyid (@keyids_ok) {
870 # get key listing
871 #################
872 my $gpg = GnuPG::Interface->new();
873 $gpg->call( $CONFIG{'gpg'} );
874 $gpg->options->hash_init(
875 'homedir' => $GNUPGHOME,
876 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
877 $gpg->options->meta_interactive( 0 );
878 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
879 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
880 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
881 waitpid $pid, 0;
882 if ($stdout eq '') {
883 warn ("No data from gpg for list-key $keyid\n");
884 next;
885 };
886 my @publine = grep { /^pub/ } (split /\n/, $stdout);
887 if (scalar @publine == 0) {
888 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
889 next;
890 };
891 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
892 if (scalar @publine > 0) {
893 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
894 next;
895 };
896 unless (defined $longkeyid) {
897 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
898 next;
899 };
900 unless (defined $flags) {
901 warn ("Didn't find flags in --list-key of key $keyid.\n");
902 next;
903 };
904 my $can_encrypt = $flags =~ /E/;
905
906 # export the key
907 ################
908 my $asciikey = export_key($GNUPGHOME, $keyid);
909 if ($asciikey eq '') {
910 warn ("No data from gpg for export $keyid\n");
911 next;
912 };
913
914 my @UIDS;
915 my $uid_number = 0;
916 while (1) {
917 my $this_uid_text = '';
918 $uid_number++;
919 debug("Doing key $keyid, uid $uid_number");
920 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
921
922 # import into temporary gpghome
923 ###############################
924 my $result = import_key($tempdir, $asciikey);
925 unless ($result) {
926 warn ("Could not import $keyid into temporary gnupg.\n");
927 next;
928 };
929
930 # prune it
931 ##########
932 $gpg = GnuPG::Interface->new();
933 $gpg->call( $CONFIG{'gpg-delsig'} );
934 $gpg->options->hash_init(
935 'homedir' => $tempdir,
936 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
937 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
938 $pid = $gpg->wrap_call(
939 commands => [ '--edit' ],
940 command_args => [ $keyid ],
941 handles => $handles );
942
943 debug("Starting edit session");
944 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
945
946 # delete other uids
947 ###################
948 my $number_of_subkeys = 0;
949 my $i = 1;
950 my $have_one = 0;
951 my $is_uat = 0;
952 my $delete_some = 0;
953 debug("Parsing stdout output.");
954 for my $line (split /\n/, $stdout) {
955 debug("Checking line $line");
956 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
957 if ($type eq 'sub') {
958 $number_of_subkeys++;
959 };
960 next unless ($type eq 'uid' || $type eq 'uat');
961 debug("line is interesting.");
962 if ($uid_number != $i) {
963 debug("mark for deletion.");
964 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
965 $delete_some++;
966 } else {
967 debug("keep it.");
968 $have_one = 1;
969 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
970 $is_uat = $type eq 'uat';
971 };
972 $i++;
973 };
974 debug("Parsing stdout output done.");
975 unless ($have_one) {
976 debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
977 info("key $keyid done.");
978 last;
979 };
980
981 my $prune_some_sigs_on_uid;
982 my $prune_all_sigs_on_uid;
983 if ($is_uat) {
984 debug("handling attribute userid of key $keyid.");
985 if ($uid_number == 1) {
986 debug(" attribute userid is #1, unmarking #2 for deletion.");
987 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
988 $delete_some--;
989 $prune_some_sigs_on_uid = 1;
990 $prune_all_sigs_on_uid = 2;
991 } else {
992 debug("attribute userid is not #1, unmarking #1 for deletion.");
993 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
994 $delete_some--;
995 $prune_some_sigs_on_uid = 2;
996 $prune_all_sigs_on_uid = 1;
997 };
998 } else {
999 $prune_some_sigs_on_uid = 1;
1000 };
1001
1002 if ($delete_some) {
1003 debug("need to delete $delete_some uids.");
1004 readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
1005 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1006 };
1007
1008 # delete subkeys
1009 ################
1010 if ($number_of_subkeys > 0) {
1011 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1012 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1013 };
1014 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
1015 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1016 };
1017
1018 # delete signatures
1019 ###################
1020 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1021 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1022 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1023 if (defined $prune_all_sigs_on_uid) {
1024 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1025 delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1026 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1027 };
1028
1029
1030 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1031 waitpid $pid, 0;
1032
1033 my $asciikey = export_key($tempdir, $keyid);
1034 if ($asciikey eq '') {
1035 warn ("No data from gpg for export $keyid\n");
1036 next;
1037 };
1038
1039 if ($signed_by_me) {
1040 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1041 my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1042 next unless $write;
1043 };
1044 my $keydir = "$KEYSBASE/$DATE_STRING";
1045 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1046
1047 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1048 open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1049 print KEY $asciikey;
1050 close KEY;
1051
1052 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
1053
1054 info("$longkeyid $uid_number $this_uid_text done.");
1055 } else {
1056 info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1057 };
1058 };
1059
1060 if (scalar @UIDS == 0) {
1061 info("found no signed uids for $keyid");
1062 } else {
1063 next if $CONFIG{'no-mail'}; # do not send mail
1064
1065 my @attached;
1066 for my $uid (@UIDS) {
1067 trace("UID: $uid->{'text'}\n");
1068 if ($uid->{'is_uat'}) {
1069 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1070 push @attached, $uid if $attach;
1071 } elsif ($uid->{'text'} !~ /@/) {
1072 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1073 push @attached, $uid if $attach;
1074 };
1075 };
1076
1077 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1078 for my $uid (@UIDS) {
1079 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1080 my $address = $uid->{'text'};
1081 $address =~ s/.*<(.*)>.*/$1/;
1082 if (ask("Send mail to '$address' for $uid->{'text'}?", 1, $CONFIG{'mail'})) {
1083 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1084
1085 my $keydir = "$KEYSBASE/$DATE_STRING";
1086 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1087 open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1088 print KEY $mail;
1089 close KEY;
1090 };
1091 };
1092 };
1093 };
1094
1095 };