]> git.sthu.org Git - pgp-tools.git/blob - caff/caff
dd74de713e7d963d779e02de22bdaf3ea679bef3
[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 my $answer;
442 while (1) {
443 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
444 if ($forceyes && $forceno) {
445 print "$default (from config/command line)\n";
446 return $default;
447 };
448 if ($forceyes) {
449 print "YES (from config/command line)\n";
450 return 1;
451 };
452 if ($forceno) {
453 print "NO (from config/command line)\n";
454 return 0;
455 };
456
457 $answer = <STDIN>;
458 chomp $answer;
459 last if ((defined $answer) && (length $answer <= 1));
460 print "grrrrrr.\n";
461 sleep 1;
462 };
463 my $result = $default;
464 $result = 1 if $answer =~ /y/i;
465 $result = 0 if $answer =~ /n/i;
466 return $result;
467 };
468
469
470
471
472
473 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
474 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
475 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
476 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
477 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
478
479 load_config;
480 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
481
482 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
483 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
484
485 -d $KEYSBASE || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
486 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
487
488 my $NOW = time;
489 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
490 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
491
492
493 sub version($) {
494 my ($fd) = @_;
495 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
496 };
497
498 sub usage($$) {
499 my ($fd, $exitcode) = @_;
500 version($fd);
501 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
502 print $fd "Consult the manual page for more information.\n";
503 exit $exitcode;
504 };
505
506 ######
507 # export key $keyid from $gnupghome
508 ######
509 sub export_key($$) {
510 my ($gnupghome, $keyid) = @_;
511
512 my $gpg = GnuPG::Interface->new();
513 $gpg->call( $CONFIG{'gpg'} );
514 if (defined $gnupghome) {
515 $gpg->options->hash_init(
516 'homedir' => $gnupghome,
517 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
518 'armor' => 1 );
519 } else {
520 $gpg->options->hash_init(
521 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
522 'armor' => 1 );
523 };
524 $gpg->options->meta_interactive( 0 );
525 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
526 my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
527 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
528 waitpid $pid, 0;
529
530 return $stdout;
531 };
532
533 ######
534 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
535 ######
536 sub import_key($$) {
537 my ($gnupghome, $asciikey) = @_;
538
539 my $gpg = GnuPG::Interface->new();
540 $gpg->call( $CONFIG{'gpg'} );
541 $gpg->options->hash_init(
542 'homedir' => $gnupghome,
543 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] );
544 $gpg->options->meta_interactive( 0 );
545 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
546 my $pid = $gpg->import_keys(handles => $handles);
547 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
548 waitpid $pid, 0;
549
550 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
551 return undef;
552 };
553 return 1;
554 };
555
556
557 ######
558 # Send an email to $address. If $can_encrypt is true then the mail
559 # will be PGP/MIME encrypted to $longkeyid.
560 #
561 # $longkeyid, $uid, and @attached will be used in the email and the template.
562 ######
563 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
564 sub send_mail($$$@) {
565 my ($address, $can_encrypt, $key_id, @keys) = @_;
566
567 my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
568 or die "Error creating template: $Text::Template::ERROR";
569
570 my @uids;
571 for my $key (@keys) {
572 push @uids, $key->{'text'};
573 };
574 my $message = $template->fill_in(HASH => { key => $key_id,
575 uids => \@uids,
576 owner => $CONFIG{'owner'}})
577 or die "Error filling template in: $Text::Template::ERROR";
578
579 my $message_entity = MIME::Entity->build(
580 Type => "text/plain",
581 Charset => "utf-8",
582 Disposition => 'inline',
583 Data => $message);
584
585 my @key_entities;
586 for my $key (@keys) {
587 $message_entity->attach(
588 Type => "application/pgp-keys",
589 Disposition => 'attachment',
590 Encoding => "7bit",
591 Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
592 Data => $key->{'key'},
593 Filename => "0x$key_id.".$key->{'serial'}.".asc");
594 };
595
596 if ($can_encrypt) {
597 my $message = $message_entity->stringify();
598
599 my $gpg = GnuPG::Interface->new();
600 $gpg->call( $CONFIG{'gpg'} );
601 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
602 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
603 'armor' => 1 );
604 $gpg->options->meta_interactive( 0 );
605 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
606 $gpg->options->push_recipients( $key_id );
607 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
608 my $pid = $gpg->encrypt(handles => $handles);
609 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
610 waitpid $pid, 0;
611 if ($stdout eq '') {
612 warn ("No data from gpg for list-key $key_id\n");
613 next;
614 };
615 $message = $stdout;
616
617 $message_entity = MIME::Entity->build(
618 Type => 'multipart/encrypted; protocol="application/pgp-encrypted"');
619
620 $message_entity->attach(
621 Type => "application/pgp-encrypted",
622 Disposition => 'attachment',
623 Encoding => "7bit",
624 Data => "Version: 1\n");
625
626 $message_entity->attach(
627 Type => "application/octet-stream",
628 Filename => 'msg.asc',
629 Disposition => 'inline',
630 Encoding => "7bit",
631 Data => $message);
632 };
633
634 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
635 $message_entity->head->add("To", $address);
636 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
637 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
638 $message_entity->head->add("User-Agent", $USER_AGENT);
639 $message_entity->send();
640 $message_entity->stringify();
641 };
642
643 ######
644 # clean up a UID so that it can be used on the FS.
645 ######
646 sub sanitize_uid($) {
647 my ($uid) = @_;
648
649 my $good_uid = $uid;
650 $good_uid =~ tr#/:\\#_#;
651 trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
652 return $good_uid;
653 };
654
655 sub delete_signatures($$$$$$) {
656 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
657
658 my $signed_by_me = 0;
659
660 my ($stdout, $stderr, $status) =
661 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
662
663 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
664 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
665 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
666 $stdout =~ s/\n/\\n/g;
667 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
668 my $line = pop @sigline;
669 my $answer = "no";
670 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
671 debug("[sigremoval] doing line $line.");
672 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
673 if ($signer eq $longkeyid) {
674 debug("[sigremoval] selfsig ($signer).");
675 $answer = "no";
676 } elsif (grep { $signer eq $_ } @{$keyids}) {
677 debug("[sigremoval] signed by us ($signer).");
678 $answer = "no";
679 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
680 } else {
681 debug("[sigremoval] not interested in that sig ($signer).");
682 $answer = "yes";
683 };
684 } else {
685 debug("[sigremoval] no sig line here, only got: ".$stdout);
686 };
687 ($stdout, $stderr, $status) =
688 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
689 };
690
691 return $signed_by_me;
692 };
693
694
695
696 my $USER;
697 my @KEYIDS;
698 my $params;
699
700 Getopt::Long::config('bundling');
701 if (!GetOptions (
702 '-h' => \$params->{'help'},
703 '--help' => \$params->{'help'},
704 '--version' => \$params->{'version'},
705 '-V' => \$params->{'version'},
706 '-u=s' => \$params->{'local-user'},
707 '--local-user=s' => \$params->{'local-user'},
708 '-e' => \$params->{'export-old'},
709 '--export-old' => \$params->{'export-old'},
710 '-E' => \$params->{'no-export-old'},
711 '--no-export-old' => \$params->{'no-export-old'},
712 '-m' => \$params->{'mail'},
713 '--mail' => \$params->{'mail'},
714 '-M' => \$params->{'no-mail'},
715 '--no-mail' => \$params->{'no-mail'},
716 '-R' => \$params->{'no-download'},
717 '--no-download' => \$params->{'no-download'},
718 '-S' => \$params->{'no-sign'},
719 '--no-sign' => \$params->{'no-sign'},
720 )) {
721 usage(\*STDERR, 1);
722 };
723 if ($params->{'help'}) {
724 usage(\*STDOUT, 0);
725 };
726 if ($params->{'version'}) {
727 version(\*STDOUT);
728 exit(0);
729 };
730 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
731
732
733
734 if ($params->{'local-user'}) {
735 $USER = $params->{'local-user'};
736 $USER =~ s/^0x//i;
737 unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
738 print STDERR "-u $USER is not a keyid.\n";
739 usage(\*STDERR, 1);
740 };
741 $USER = uc($USER);
742 };
743
744 for my $keyid (@ARGV) {
745 $keyid =~ s/^0x//i;
746 unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
747 if ($keyid =~ /^[A-F0-9]{32}$/) {
748 info("Ignoring v3 fingerprint $keyid. v3 keys are obsolete.");
749 next;
750 };
751 print STDERR "$keyid is not a keyid.\n";
752 usage(\*STDERR, 1);
753 };
754 push @KEYIDS, uc($keyid);
755 };
756
757 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
758 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
759 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
760 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
761
762
763 #################
764 # import own keys
765 #################
766 for my $keyid (@{$CONFIG{'keyid'}}) {
767 my $gpg = GnuPG::Interface->new();
768 $gpg->call( $CONFIG{'gpg'} );
769 $gpg->options->hash_init(
770 'homedir' => $GNUPGHOME,
771 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --fast-list-mode } ] );
772 $gpg->options->meta_interactive( 0 );
773 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
774 my $pid = $gpg->list_public_keys(handles => $handles, command_args => $keyid);
775 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
776 waitpid $pid, 0;
777
778 if ($stdout eq '') {
779 warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
780 };
781 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
782 info("Key $keyid not found in caff's home. Getting it from your normal GnuPGHome.");
783 my $key = export_key(undef, $keyid);
784 if (!defined $key || $key eq '') {
785 warn ("Did not get key $keyid from your normal GnuPGHome\n");
786 next;
787 };
788 my $result = import_key($GNUPGHOME, $key);
789 unless ($result) {
790 warn ("Could not import $keyid into caff's gnupghome.\n");
791 next;
792 };
793 }
794 }
795
796 #############################
797 # receive keys from keyserver
798 #############################
799 my @keyids_ok;
800 if ($CONFIG{'no-download'}) {
801 @keyids_ok = @KEYIDS;
802 } else {
803 info ("fetching keys, this will take a while...");
804
805 my $gpg = GnuPG::Interface->new();
806 $gpg->call( $CONFIG{'gpg'} );
807 $gpg->options->hash_init(
808 'homedir' => $GNUPGHOME,
809 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
810 $gpg->options->meta_interactive( 0 );
811 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
812 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
813 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
814 waitpid $pid, 0;
815
816 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
817 # [GNUPG:] NODATA 1
818 # [GNUPG:] NODATA 1
819 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
820 my %local_keyids = map { $_ => 1 } @KEYIDS;
821 for my $line (split /\n/, $status) {
822 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
823 my $imported_key = $1;
824 my $whole_fpr = $imported_key;
825 my $long_keyid = substr($imported_key, -16);
826 my $short_keyid = substr($imported_key, -8);
827 my $speced_key;
828 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
829 $speced_key = $spec if $local_keyids{$spec};
830 };
831 unless ($speced_key) {
832 notice ("Imported unexpected key; got: $imported_key\n");
833 next;
834 };
835 debug ("Imported $imported_key for $speced_key");
836 delete $local_keyids{$speced_key};
837 unshift @keyids_ok, $imported_key;
838 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
839 } else {
840 notice ("got unknown reply from gpg: $line");
841 }
842 };
843 if (scalar %local_keyids) {
844 notice ("Import failed for: ". (join ' ', keys %local_keyids).".");
845 exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
846 }
847 };
848
849 unless (@keyids_ok) {
850 notice ("No keys to sign found");
851 exit 0;
852 }
853
854 ###########
855 # sign keys
856 ###########
857 if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
858 $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
859 }
860
861 unless ($CONFIG{'no-sign'}) {
862 info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
863 for my $keyid (@keyids_ok) {
864 my @command;
865 push @command, $CONFIG{'gpg-sign'};
866 push @command, '--local-user', $USER if (defined $USER);
867 push @command, "--homedir=$GNUPGHOME";
868 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
869 push @command, '--no-auto-check-trustdb';
870 push @command, '--trust-model=always';
871 push @command, '--edit', $keyid;
872 push @command, 'sign';
873 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
874 print join(' ', @command),"\n";
875 system (@command);
876 };
877 };
878
879 ##################
880 # export and prune
881 ##################
882 KEYS:
883 for my $keyid (@keyids_ok) {
884 # get key listing
885 #################
886 my $gpg = GnuPG::Interface->new();
887 $gpg->call( $CONFIG{'gpg'} );
888 $gpg->options->hash_init(
889 'homedir' => $GNUPGHOME,
890 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
891 $gpg->options->meta_interactive( 0 );
892 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
893 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
894 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
895 waitpid $pid, 0;
896 if ($stdout eq '') {
897 warn ("No data from gpg for list-key $keyid\n");
898 next;
899 };
900 my @publine = grep { /^pub/ } (split /\n/, $stdout);
901 if (scalar @publine == 0) {
902 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
903 next;
904 };
905 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
906 if (scalar @publine > 0) {
907 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
908 next;
909 };
910 unless (defined $longkeyid) {
911 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
912 next;
913 };
914 unless (defined $flags) {
915 warn ("Didn't find flags in --list-key of key $keyid.\n");
916 next;
917 };
918 my $can_encrypt = $flags =~ /E/;
919
920 # export the key
921 ################
922 my $asciikey = export_key($GNUPGHOME, $keyid);
923 if ($asciikey eq '') {
924 warn ("No data from gpg for export $keyid\n");
925 next;
926 };
927
928 my @UIDS;
929 my $uid_number = 0;
930 while (1) {
931 my $this_uid_text = '';
932 $uid_number++;
933 debug("Doing key $keyid, uid $uid_number");
934 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
935
936 # import into temporary gpghome
937 ###############################
938 my $result = import_key($tempdir, $asciikey);
939 unless ($result) {
940 warn ("Could not import $keyid into temporary gnupg.\n");
941 next;
942 };
943
944 # prune it
945 ##########
946 $gpg = GnuPG::Interface->new();
947 $gpg->call( $CONFIG{'gpg-delsig'} );
948 $gpg->options->hash_init(
949 'homedir' => $tempdir,
950 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
951 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
952 $pid = $gpg->wrap_call(
953 commands => [ '--edit' ],
954 command_args => [ $keyid ],
955 handles => $handles );
956
957 debug("Starting edit session");
958 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
959
960 # delete other uids
961 ###################
962 my $number_of_subkeys = 0;
963 my $i = 1;
964 my $have_one = 0;
965 my $is_uat = 0;
966 my $delete_some = 0;
967 debug("Parsing stdout output.");
968 for my $line (split /\n/, $stdout) {
969 debug("Checking line $line");
970 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
971 if ($type eq 'sub') {
972 $number_of_subkeys++;
973 };
974 next unless ($type eq 'uid' || $type eq 'uat');
975 debug("line is interesting.");
976 if ($uid_number != $i) {
977 debug("mark for deletion.");
978 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
979 $delete_some++;
980 } else {
981 debug("keep it.");
982 $have_one = 1;
983 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
984 $is_uat = $type eq 'uat';
985 };
986 $i++;
987 };
988 debug("Parsing stdout output done.");
989 unless ($have_one) {
990 debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
991 info("key $keyid done.");
992 last;
993 };
994
995 my $prune_some_sigs_on_uid;
996 my $prune_all_sigs_on_uid;
997 if ($is_uat) {
998 debug("handling attribute userid of key $keyid.");
999 if ($uid_number == 1) {
1000 debug(" attribute userid is #1, unmarking #2 for deletion.");
1001 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1002 $delete_some--;
1003 $prune_some_sigs_on_uid = 1;
1004 $prune_all_sigs_on_uid = 2;
1005 } else {
1006 debug("attribute userid is not #1, unmarking #1 for deletion.");
1007 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1008 $delete_some--;
1009 $prune_some_sigs_on_uid = 2;
1010 $prune_all_sigs_on_uid = 1;
1011 };
1012 } else {
1013 $prune_some_sigs_on_uid = 1;
1014 };
1015
1016 if ($delete_some) {
1017 debug("need to delete $delete_some uids.");
1018 readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
1019 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1020 };
1021
1022 # delete subkeys
1023 ################
1024 if ($number_of_subkeys > 0) {
1025 for (my $i=1; $i<=$number_of_subkeys; $i++) {
1026 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1027 };
1028 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
1029 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1030 };
1031
1032 # delete signatures
1033 ###################
1034 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1035 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1036 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1037 if (defined $prune_all_sigs_on_uid) {
1038 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1039 delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1040 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1041 };
1042
1043
1044 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1045 waitpid $pid, 0;
1046
1047 my $asciikey = export_key($tempdir, $keyid);
1048 if ($asciikey eq '') {
1049 warn ("No data from gpg for export $keyid\n");
1050 next;
1051 };
1052
1053 if ($signed_by_me) {
1054 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1055 my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1056 next unless $write;
1057 };
1058 my $keydir = "$KEYSBASE/$DATE_STRING";
1059 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1060
1061 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1062 open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1063 print KEY $asciikey;
1064 close KEY;
1065
1066 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
1067
1068 info("$longkeyid $uid_number $this_uid_text done.");
1069 } else {
1070 info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1071 };
1072 };
1073
1074 if (scalar @UIDS == 0) {
1075 info("found no signed uids for $keyid");
1076 } else {
1077 next if $CONFIG{'no-mail'}; # do not send mail
1078
1079 my @attached;
1080 for my $uid (@UIDS) {
1081 trace("UID: $uid->{'text'}\n");
1082 if ($uid->{'is_uat'}) {
1083 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1084 push @attached, $uid if $attach;
1085 } elsif ($uid->{'text'} !~ /@/) {
1086 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1087 push @attached, $uid if $attach;
1088 };
1089 };
1090
1091 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1092 for my $uid (@UIDS) {
1093 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1094 my $address = $uid->{'text'};
1095 $address =~ s/.*<(.*)>.*/$1/;
1096 if (ask("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
1097 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1098
1099 my $keydir = "$KEYSBASE/$DATE_STRING";
1100 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1101 open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1102 print KEY $mail;
1103 close KEY;
1104 };
1105 };
1106 };
1107 };
1108
1109 };