]> git.sthu.org Git - pgp-tools.git/blob - caff/pgp-clean
do not continue after writing template config file
[pgp-tools.git] / caff / pgp-clean
1 #!/usr/bin/perl -w
2
3 # pgp-clean -- remove all non-self signatures from key
4 # $Id$
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 pgp-clean -- remove all non-self signatures from key
37
38 =head1 SYNOPSIS
39
40 =over
41
42 =item B<pgp-clean> I<keyid> [I<keyid> ...]
43
44 =back
45
46 =head1 DESCRIPTION
47
48 B<pgp-clean> takes a list of keyids on the command line and outputs an
49 ascii-armored keyring on stdout for each key with all signatures except
50 self-signatures stripped. Its use is to reduce the size of keys sent out after
51 signing (e.g. with B<caff>).
52
53 =head1 OPTIONS
54
55 =over
56
57 =item I<keyid>
58
59 Use this key.
60
61 =back
62
63 =head1 FILES
64
65 =over
66
67 =item $HOME/.gnupg/pubring.gpg - default GnuPG keyring
68
69 =back
70
71 =head1 SEE ALSO
72
73 caff(1), gpg(1).
74
75 =head1 AUTHOR
76
77 Peter Palfrader <peter@palfrader.org>
78
79 This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
80
81 =cut
82
83 use strict;
84 use IO::Handle;
85 use English;
86 use File::Path;
87 use File::Temp qw{tempdir};
88 use Fcntl;
89 use IO::Select;
90 use GnuPG::Interface;
91
92 my $REVISION = '$Rev$';
93 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
94 my $VERSION = "0.0.0.$REVISION_NUMER";
95
96 sub notice($) {
97 my ($line) = @_;
98 print STDERR "[NOTICE] $line\n";
99 };
100 sub info($) {
101 my ($line) = @_;
102 print STDERR "[INFO] $line\n";
103 };
104 sub debug($) {
105 my ($line) = @_;
106 #print STDERR "[DEBUG] $line\n";
107 };
108 sub trace($) {
109 my ($line) = @_;
110 #print STDERR "[trace] $line\n";
111 };
112 sub trace2($) {
113 my ($line) = @_;
114 #print STDERR "[trace2] $line\n";
115 };
116
117 sub make_gpg_fds() {
118 my %fds = (
119 stdin => IO::Handle->new(),
120 stdout => IO::Handle->new(),
121 stderr => IO::Handle->new(),
122 status => IO::Handle->new() );
123 my $handles = GnuPG::Handles->new( %fds );
124 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
125 };
126
127 sub readwrite_gpg($$$$$%) {
128 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
129
130 trace("Entering readwrite_gpg.");
131
132 my ($first_line, $dummy) = split /\n/, $in;
133 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
134
135 local $INPUT_RECORD_SEPARATOR = undef;
136 my $sout = IO::Select->new();
137 my $sin = IO::Select->new();
138 my $offset = 0;
139
140 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
141
142 $inputfd->blocking(0);
143 $stdoutfd->blocking(0);
144 $statusfd->blocking(0) if defined $statusfd;
145 $stderrfd->blocking(0);
146 $sout->add($stdoutfd);
147 $sout->add($stderrfd);
148 $sout->add($statusfd) if defined $statusfd;
149 $sin->add($inputfd);
150
151 my ($stdout, $stderr, $status) = ("", "", "");
152 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
153 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
154
155 my $readwrote_stuff_this_time = 0;
156 my $do_not_wait_on_select = 0;
157 my ($readyr, $readyw, $written);
158 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
159 if (defined $exitwhenstatusmatches) {
160 if ($status =~ /$exitwhenstatusmatches/m) {
161 trace("readwrite_gpg found match on $exitwhenstatusmatches");
162 if ($readwrote_stuff_this_time) {
163 trace("read/write some more\n");
164 $do_not_wait_on_select = 1;
165 } else {
166 trace("that's it in our while loop.\n");
167 last;
168 }
169 };
170 };
171
172 $readwrote_stuff_this_time = 0;
173 trace("select waiting for ".($sout->count())." fds.");
174 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
175 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
176 for my $wfd (@$readyw) {
177 $readwrote_stuff_this_time = 1;
178 if (length($in) != $offset) {
179 trace("writing to $wfd.");
180 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
181 $offset += $written;
182 };
183 if ($offset == length($in)) {
184 trace("writing to $wfd done.");
185 unless ($options{'nocloseinput'}) {
186 close $wfd;
187 trace("$wfd closed.");
188 };
189 $sin->remove($wfd);
190 $sin = undef;
191 }
192 }
193
194 next unless (defined(@$readyr)); # Wait some more.
195
196 for my $rfd (@$readyr) {
197 $readwrote_stuff_this_time = 1;
198 if ($rfd->eof) {
199 trace("reading from $rfd done.");
200 $sout->remove($rfd);
201 close($rfd);
202 next;
203 }
204 trace("reading from $rfd.");
205 if ($rfd == $stdoutfd) {
206 $stdout .= <$rfd>;
207 trace2("stdout is now $stdout\n================");
208 next;
209 }
210 if (defined $statusfd && $rfd == $statusfd) {
211 $status .= <$rfd>;
212 trace2("status is now $status\n================");
213 next;
214 }
215 if ($rfd == $stderrfd) {
216 $stderr .= <$rfd>;
217 trace2("stderr is now $stderr\n================");
218 next;
219 }
220 }
221 }
222 trace("readwrite_gpg done.");
223 return ($stdout, $stderr, $status);
224 };
225
226 sub export_key($$) {
227 my ($gnupghome, $keyid) = @_;
228
229 my $gpg = GnuPG::Interface->new();
230 my %confighash = ( armor => 1 );
231 $confighash{'homedir'}=$gnupghome if (defined $gnupghome);
232 $gpg->options->hash_init( %confighash );
233 $gpg->options->meta_interactive( 0 );
234 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
235 my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
236 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
237 waitpid $pid, 0;
238
239 return $stdout;
240 };
241
242 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
243 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
244 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
245 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
246 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
247
248
249 sub usage() {
250 print STDERR "pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n";
251 print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
252 exit 1;
253 };
254
255 usage() unless scalar @ARGV >= 1;
256 my @KEYIDS;
257 for my $keyid (@ARGV) {
258 $keyid =~ s/^0x//i;
259 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
260 print STDERR "$keyid is not a keyid.\n";
261 usage();
262 };
263 push @KEYIDS, uc($keyid);
264 };
265
266
267
268 ##################
269 # export and prune
270 ##################
271 KEYS:
272 for my $keyid (@KEYIDS) {
273 # get key listing
274 #################
275 my $gpg = GnuPG::Interface->new();
276 $gpg->options->meta_interactive( 0 );
277 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
278 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
279 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
280 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
281 waitpid $pid, 0;
282 if ($stdout eq '') {
283 warn ("No data from gpg for list-key $keyid\n");
284 next;
285 };
286 my $keyinfo = $stdout;
287 my @publine = grep { /^pub/ } (split /\n/, $stdout);
288 my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
289 my $can_encrypt = $flags =~ /E/;
290 unless (defined $longkeyid) {
291 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
292 next;
293 };
294
295 # export the key
296 ################
297 my $asciikey = export_key(undef, $keyid);
298 if ($asciikey eq '') {
299 warn ("No data from gpg for export $keyid\n");
300 next;
301 };
302
303 my @UIDS;
304 my $uid_number = 0;
305 my $this_uid_text = '';
306 $uid_number++;
307 debug("Doing key $keyid, uid $uid_number");
308
309 # import into temporary gpghome
310 ###############################
311 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
312 $gpg = GnuPG::Interface->new();
313 $gpg->options->hash_init( 'homedir' => $tempdir );
314 $gpg->options->meta_interactive( 0 );
315 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
316 $pid = $gpg->import_keys(handles => $handles);
317 ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
318 waitpid $pid, 0;
319
320 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
321 warn ("Could not import $keyid into temporary gnupg.\n");
322 next;
323 };
324
325 # prune it
326 ##########
327 $gpg = GnuPG::Interface->new();
328 $gpg->options->hash_init(
329 'homedir' => $tempdir,
330 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
331 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
332 $pid = $gpg->wrap_call(
333 commands => [ '--edit' ],
334 command_args => [ $keyid ],
335 handles => $handles );
336
337 debug("Starting edit session");
338 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
339
340 # mark all uids
341 ###################
342 my $number_of_subkeys = 0;
343 my $i = 1;
344 my $have_one = 0;
345 my $is_uat = 0;
346 my $delete_some = 0;
347 debug("Parsing stdout output.");
348 for my $line (split /\n/, $stdout) {
349 debug("Checking line $line");
350 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
351 if ($type eq 'sub') {
352 $number_of_subkeys++;
353 };
354 next unless ($type eq 'uid' || $type eq 'uat');
355 debug("line is interesting.");
356 debug("mark uid.");
357 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
358 $i++;
359 };
360 debug("Parsing stdout output done.");
361
362 # delete subkeys
363 ################
364 if ($number_of_subkeys > 0) {
365 for (my $i=1; $i<=$number_of_subkeys; $i++) {
366 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
367 };
368 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
369 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
370 };
371
372 # delete signatures
373 ###################
374 my $signed_by_me = 0;
375 ($stdout, $stderr, $status) =
376 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
377
378 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
379 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
380 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
381 $stdout =~ s/\n/\\n/g;
382 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
383 my $line = pop @sigline;
384 my $answer = "no";
385 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
386 debug("[sigremoval] doing line $line.");
387 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
388 if ($signer eq $longkeyid) {
389 debug("[sigremoval] selfsig ($signer).");
390 $answer = "no";
391 } else {
392 debug("[sigremoval] not interested in that sig ($signer).");
393 $answer = "yes";
394 };
395 } else {
396 debug("[sigremoval] no sig line here, only got: ".$stdout);
397 };
398 ($stdout, $stderr, $status) =
399 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
400 };
401 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
402 waitpid $pid, 0;
403
404 $asciikey = export_key($tempdir, $longkeyid);
405 if ($asciikey eq '') {
406 warn ("No data from gpg for export $longkeyid\n");
407 next;
408 };
409
410
411 print $asciikey;
412 }