]> git.sthu.org Git - pgp-tools.git/blob - caff/pgp-clean
Add pgp-clean - it's a useful tool, but really not finished
[pgp-tools.git] / caff / pgp-clean
1 #!/usr/bin/perl -w
2
3 # caff -- CA - Fire and Forget
4 # $Id: caff 37 2005-02-28 23:20:15Z weasel $
5 #
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 #
8 # All rights reserved.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
12 # are met:
13 # 1. Redistributions of source code must retain the above copyright
14 # notice, this list of conditions and the following disclaimer.
15 # 2. Redistributions in binary form must reproduce the above copyright
16 # notice, this list of conditions and the following disclaimer in the
17 # documentation and/or other materials provided with the distribution.
18 # 3. The name of the author may not be used to endorse or promote products
19 # derived from this software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
22 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
23 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
24 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
26 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
30 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32 =pod
33
34 =head1 NAME
35
36 caff -- CA - Fire and Forget
37
38 =head1 SYNOPSIS
39
40 =over
41
42 =item B<caff> [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
43
44 =back
45
46 =head1 DESCRIPTION
47
48 CA Fire and Forget is a script that helps you in keysigning. It takes a list
49 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
50 that you can sign it. It then mails each key to all its email addresses - only
51 including the one UID that we send to in each mail, pruned from all but self
52 sigs and sigs done by you.
53
54 =head1 OPTIONS
55
56 =over
57
58 =item B<-u> I<yourkeyid>
59
60 Select the key that is used for signing, in case you have more than one key.
61
62 =back
63
64 =head1 FILES
65
66 =over
67
68 =item $HOME/.caffrc - configuration file
69
70 =back
71
72 =head1 CONFIGURATION FILE OPTIONS
73
74 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
75
76 Example:
77
78 $CONFIG{'owner'} = 'Peter Palfrader';
79 $CONFIG{'email'} = 'peter@palfrader.org';
80
81 =head2 Valid keys
82
83 =over
84
85 =item B<caffhome> [string]
86
87 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
88
89 =item B<owner> [string]
90
91 Your name. B<REQUIRED>.
92
93 =item B<email> [string]
94
95 Your email address, used in From: lines. B<REQUIRED>.
96
97 =item B<keyid> [list of keyids]
98
99 A list of your keys. This is used to determine which signatures to keep
100 in the pruning step. If you select a key using B<-u> it has to be in
101 this list. B<REQUIRED>.
102
103 =item B<export-sig-age> [seconds]
104
105 Don't export UIDs by default, on which your latest signature is older
106 than this age. Default: B<24*60*60> (i.e. one day).
107
108 =item B<keyserver> [string]
109
110 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
111
112 =item B<gpg> [string]
113
114 Path to the GnuPG binary. Default: B<gpg>.
115
116 =item B<gpg-sign> [string]
117
118 Path to the GnuPG binary which is used to sign keys. Default: what
119 B<gpg> is set to.
120
121 =item B<gpg-delsig> [string]
122
123 Path to the GnuPG binary which is used to split off signatures. This is
124 needed while the upstream GnuPG is not fixed (there are 2 bugs in the
125 Debian Bug Tracking System). Default: what B<gpg> is set to.
126
127 =item B<secret-keyring> [string]
128
129 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
130
131 =item B<also-encrypt-to> [keyid]
132
133 An additional keyid to encrypt messages to. Default: none.
134
135 =item B<no-download> [boolean]
136
137 If true, then skip the step of fetching keys from the keyserver.
138 Default: B<0>.
139
140 =item B<no-sign> [boolean]
141
142 If true, then skip the signing step. Default: B<0>.
143
144 =back
145
146 =head1 AUTHOR
147
148 Peter Palfrader <peter@palfrader.org>
149
150 =cut
151
152 use strict;
153 use IO::Handle;
154 use English;
155 use File::Path;
156 use File::Temp qw{tempdir};
157 use Fcntl;
158 use IO::Select;
159 use GnuPG::Interface;
160
161 my $REVISION = '$Rev: 37 $';
162 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
163 my $VERSION = "0.0.0.$REVISION_NUMER";
164
165 sub notice($) {
166 my ($line) = @_;
167 print STDERR "[NOTICE] $line\n";
168 };
169 sub info($) {
170 my ($line) = @_;
171 print STDERR "[INFO] $line\n";
172 };
173 sub debug($) {
174 my ($line) = @_;
175 print STDERR "[DEBUG] $line\n";
176 };
177 sub trace($) {
178 my ($line) = @_;
179 #print STDERR "[trace] $line\n";
180 };
181 sub trace2($) {
182 my ($line) = @_;
183 #print STDERR "[trace2] $line\n";
184 };
185
186 sub make_gpg_fds() {
187 my %fds = (
188 stdin => IO::Handle->new(),
189 stdout => IO::Handle->new(),
190 stderr => IO::Handle->new(),
191 status => IO::Handle->new() );
192 my $handles = GnuPG::Handles->new( %fds );
193 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
194 };
195
196 sub readwrite_gpg($$$$$%) {
197 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
198
199 trace("Entering readwrite_gpg.");
200
201 my ($first_line, $dummy) = split /\n/, $in;
202 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
203
204 local $INPUT_RECORD_SEPARATOR = undef;
205 my $sout = IO::Select->new();
206 my $sin = IO::Select->new();
207 my $offset = 0;
208
209 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
210
211 $inputfd->blocking(0);
212 $stdoutfd->blocking(0);
213 $statusfd->blocking(0) if defined $statusfd;
214 $stderrfd->blocking(0);
215 $sout->add($stdoutfd);
216 $sout->add($stderrfd);
217 $sout->add($statusfd) if defined $statusfd;
218 $sin->add($inputfd);
219
220 my ($stdout, $stderr, $status) = ("", "", "");
221 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
222 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
223
224 my $readwrote_stuff_this_time = 0;
225 my $do_not_wait_on_select = 0;
226 my ($readyr, $readyw, $written);
227 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
228 if (defined $exitwhenstatusmatches) {
229 if ($status =~ /$exitwhenstatusmatches/m) {
230 trace("readwrite_gpg found match on $exitwhenstatusmatches");
231 if ($readwrote_stuff_this_time) {
232 trace("read/write some more\n");
233 $do_not_wait_on_select = 1;
234 } else {
235 trace("that's it in our while loop.\n");
236 last;
237 }
238 };
239 };
240
241 $readwrote_stuff_this_time = 0;
242 trace("select waiting for ".($sout->count())." fds.");
243 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
244 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
245 for my $wfd (@$readyw) {
246 $readwrote_stuff_this_time = 1;
247 if (length($in) != $offset) {
248 trace("writing to $wfd.");
249 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
250 $offset += $written;
251 };
252 if ($offset == length($in)) {
253 trace("writing to $wfd done.");
254 unless ($options{'nocloseinput'}) {
255 close $wfd;
256 trace("$wfd closed.");
257 };
258 $sin->remove($wfd);
259 $sin = undef;
260 }
261 }
262
263 next unless (defined(@$readyr)); # Wait some more.
264
265 for my $rfd (@$readyr) {
266 $readwrote_stuff_this_time = 1;
267 if ($rfd->eof) {
268 trace("reading from $rfd done.");
269 $sout->remove($rfd);
270 close($rfd);
271 next;
272 }
273 trace("reading from $rfd.");
274 if ($rfd == $stdoutfd) {
275 $stdout .= <$rfd>;
276 trace2("stdout is now $stdout\n================");
277 next;
278 }
279 if (defined $statusfd && $rfd == $statusfd) {
280 $status .= <$rfd>;
281 trace2("status is now $status\n================");
282 next;
283 }
284 if ($rfd == $stderrfd) {
285 $stderr .= <$rfd>;
286 trace2("stderr is now $stderr\n================");
287 next;
288 }
289 }
290 }
291 trace("readwrite_gpg done.");
292 return ($stdout, $stderr, $status);
293 };
294
295 sub export_key($$) {
296 my ($gnupghome, $keyid) = @_;
297
298 my $gpg = GnuPG::Interface->new();
299 my %confighash = ( armor => 1 );
300 $confighash{'homedir'}=$gnupghome if (defined $gnupghome);
301 $gpg->options->hash_init( %confighash );
302 $gpg->options->meta_interactive( 0 );
303 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
304 my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
305 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
306 waitpid $pid, 0;
307
308 return $stdout;
309 };
310
311 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
312 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
313 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
314 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
315 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
316
317
318 sub usage() {
319 print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
320 print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
321 exit 1;
322 };
323
324 usage() unless scalar @ARGV >= 1;
325 my @KEYIDS;
326 for my $keyid (@ARGV) {
327 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
328 print STDERR "$keyid is not a keyid.\n";
329 usage();
330 };
331 push @KEYIDS, uc($keyid);
332 };
333
334
335
336 ##################
337 # export and prune
338 ##################
339 KEYS:
340 for my $keyid (@KEYIDS) {
341 # get key listing
342 #################
343 my $gpg = GnuPG::Interface->new();
344 $gpg->options->meta_interactive( 0 );
345 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
346 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
347 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
348 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
349 waitpid $pid, 0;
350 if ($stdout eq '') {
351 warn ("No data from gpg for list-key $keyid\n");
352 next;
353 };
354 my $keyinfo = $stdout;
355 my @publine = grep { /^pub/ } (split /\n/, $stdout);
356 my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
357 my $can_encrypt = $flags =~ /E/;
358 unless (defined $longkeyid) {
359 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
360 next;
361 };
362
363 # export the key
364 ################
365 my $asciikey = export_key(undef, $keyid);
366 if ($asciikey eq '') {
367 warn ("No data from gpg for export $keyid\n");
368 next;
369 };
370
371 my @UIDS;
372 my $uid_number = 0;
373 my $this_uid_text = '';
374 $uid_number++;
375 debug("Doing key $keyid, uid $uid_number");
376
377 # import into temporary gpghome
378 ###############################
379 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
380 $gpg = GnuPG::Interface->new();
381 $gpg->options->hash_init( 'homedir' => $tempdir );
382 $gpg->options->meta_interactive( 0 );
383 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
384 $pid = $gpg->import_keys(handles => $handles);
385 ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
386 waitpid $pid, 0;
387
388 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
389 warn ("Could not import $keyid into temporary gnupg.\n");
390 next;
391 };
392
393 # prune it
394 ##########
395 $gpg = GnuPG::Interface->new();
396 $gpg->options->hash_init(
397 'homedir' => $tempdir,
398 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
399 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
400 $pid = $gpg->wrap_call(
401 commands => [ '--edit' ],
402 command_args => [ $keyid ],
403 handles => $handles );
404
405 debug("Starting edit session");
406 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
407
408 # mark all uids
409 ###################
410 my $number_of_subkeys = 0;
411 my $i = 1;
412 my $have_one = 0;
413 my $is_uat = 0;
414 my $delete_some = 0;
415 debug("Parsing stdout output.");
416 for my $line (split /\n/, $stdout) {
417 debug("Checking line $line");
418 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
419 if ($type eq 'sub') {
420 $number_of_subkeys++;
421 };
422 next unless ($type eq 'uid' || $type eq 'uat');
423 debug("line is interesting.");
424 debug("mark uid.");
425 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
426 $i++;
427 };
428 debug("Parsing stdout output done.");
429
430 # delete subkeys
431 ################
432 if ($number_of_subkeys > 0) {
433 for (my $i=1; $i<=$number_of_subkeys; $i++) {
434 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
435 };
436 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
437 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
438 };
439
440 # delete signatures
441 ###################
442 my $signed_by_me = 0;
443 ($stdout, $stderr, $status) =
444 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
445
446 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
447 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
448 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
449 $stdout =~ s/\n/\\n/g;
450 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
451 my $line = pop @sigline;
452 my $answer = "no";
453 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
454 debug("[sigremoval] doing line $line.");
455 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
456 if ($signer eq $longkeyid) {
457 debug("[sigremoval] selfsig ($signer).");
458 $answer = "no";
459 } else {
460 debug("[sigremoval] not interested in that sig ($signer).");
461 $answer = "yes";
462 };
463 } else {
464 debug("[sigremoval] no sig line here, only got: ".$stdout);
465 };
466 ($stdout, $stderr, $status) =
467 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
468 };
469 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
470 waitpid $pid, 0;
471
472 $asciikey = export_key($tempdir, $longkeyid);
473 if ($asciikey eq '') {
474 warn ("No data from gpg for export $longkeyid\n");
475 next;
476 };
477
478
479 print $asciikey;
480 }