]>
git.sthu.org Git - pgp-tools.git/blob - caff/pgp-cleanring
ca00698cda2c8a22aa1a07fa32d48f8bc9f2cc15
3 # caff -- CA - Fire and Forget
4 # $Id: caff 37 2005-02-28 23:20:15Z weasel $
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
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.
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.
36 pgp-clean -- remove all non-self signatures from key
42 =item B<pgp-clean> I<keyid> [I<keyid> ...]
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>).
67 =item $HOME/.gnupg/pubring.gpg - default GnuPG keyring
77 Peter Palfrader <peter@palfrader.org>
79 This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
91 my $REVISION = '$Rev: 37 $';
92 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
93 my $VERSION = "0.0.0.$REVISION_NUMER";
97 print STDERR
"[NOTICE] $line\n";
101 print STDERR
"[INFO] $line\n";
105 print STDERR
"[DEBUG] $line\n";
109 #print STDERR "[trace] $line\n";
113 #print STDERR "[trace2] $line\n";
118 stdin
=> IO
::Handle
->new(),
119 stdout
=> IO
::Handle
->new(),
120 stderr
=> IO
::Handle
->new(),
121 status
=> IO
::Handle
->new() );
122 my $handles = GnuPG
::Handles
->new( %fds );
123 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
126 sub readwrite_gpg
($$$$$%) {
127 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
129 trace
("Entering readwrite_gpg.");
131 my ($first_line, $dummy) = split /\n/, $in;
132 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
134 local $INPUT_RECORD_SEPARATOR = undef;
135 my $sout = IO
::Select
->new();
136 my $sin = IO
::Select
->new();
139 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
141 $inputfd->blocking(0);
142 $stdoutfd->blocking(0);
143 $statusfd->blocking(0) if defined $statusfd;
144 $stderrfd->blocking(0);
145 $sout->add($stdoutfd);
146 $sout->add($stderrfd);
147 $sout->add($statusfd) if defined $statusfd;
150 my ($stdout, $stderr, $status) = ("", "", "");
151 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
152 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
154 my $readwrote_stuff_this_time = 0;
155 my $do_not_wait_on_select = 0;
156 my ($readyr, $readyw, $written);
157 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
158 if (defined $exitwhenstatusmatches) {
159 if ($status =~ /$exitwhenstatusmatches/m) {
160 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
161 if ($readwrote_stuff_this_time) {
162 trace
("read/write some more\n");
163 $do_not_wait_on_select = 1;
165 trace
("that's it in our while loop.\n");
171 $readwrote_stuff_this_time = 0;
172 trace
("select waiting for ".($sout->count())." fds.");
173 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
174 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
175 for my $wfd (@
$readyw) {
176 $readwrote_stuff_this_time = 1;
177 if (length($in) != $offset) {
178 trace
("writing to $wfd.");
179 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
182 if ($offset == length($in)) {
183 trace
("writing to $wfd done.");
184 unless ($options{'nocloseinput'}) {
186 trace
("$wfd closed.");
193 next unless (defined(@
$readyr)); # Wait some more.
195 for my $rfd (@
$readyr) {
196 $readwrote_stuff_this_time = 1;
198 trace
("reading from $rfd done.");
203 trace
("reading from $rfd.");
204 if ($rfd == $stdoutfd) {
206 trace2
("stdout is now $stdout\n================");
209 if (defined $statusfd && $rfd == $statusfd) {
211 trace2
("status is now $status\n================");
214 if ($rfd == $stderrfd) {
216 trace2
("stderr is now $stderr\n================");
221 trace
("readwrite_gpg done.");
222 return ($stdout, $stderr, $status);
225 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
226 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
227 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
228 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
229 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
233 print STDERR
"pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n";
234 print STDERR
"Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
238 usage
() unless scalar @ARGV >= 1;
240 for my $keyid (@ARGV) {
242 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
243 print STDERR
"$keyid is not a keyid.\n";
246 push @KEYIDS, uc($keyid);
254 for my $keyid (@KEYIDS) {
257 my $gpg = GnuPG
::Interface
->new();
258 $gpg->options->meta_interactive( 0 );
259 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
260 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
261 my $pid = $gpg->list_public_keys(handles
=> $handles, command_args
=> [ $keyid ]);
262 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
265 warn ("No data from gpg for list-key $keyid\n");
268 my $keyinfo = $stdout;
269 my @publine = grep { /^pub/ } (split /\n/, $stdout);
270 my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
271 my $can_encrypt = $flags =~ /E/;
272 unless (defined $longkeyid) {
273 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
279 my $this_uid_text = '';
281 debug
("Doing key $keyid, uid $uid_number");
285 $gpg = GnuPG
::Interface
->new();
286 $gpg->options->hash_init(
287 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
288 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
289 $pid = $gpg->wrap_call(
290 commands
=> [ '--edit' ],
291 command_args
=> [ $keyid ],
292 handles
=> $handles );
294 debug
("Starting edit session");
295 ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
299 my $number_of_subkeys = 0;
304 debug
("Parsing stdout output.");
305 for my $line (split /\n/, $stdout) {
306 debug
("Checking line $line");
307 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
308 if ($type eq 'sub') {
309 $number_of_subkeys++;
311 next unless ($type eq 'uid' || $type eq 'uat');
312 debug
("line is interesting.");
314 readwrite_gpg
("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_PROMPT, nocloseinput
=> 1);
317 debug
("Parsing stdout output done.");
321 ($stdout, $stderr, $status) =
322 readwrite_gpg
("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT, nocloseinput
=> 1);
324 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
325 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
326 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
327 $stdout =~ s/\n/\\n/g;
328 notice
("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
329 my $line = pop @sigline;
331 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
332 debug
("[sigremoval] doing line $line.");
333 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
334 if ($signer eq ('-1' x
16)) {
335 debug
("[sigremoval] not interested in that sig ($signer).");
339 debug
("[sigremoval] no sig line here, only got: ".$stdout);
341 ($stdout, $stderr, $status) =
342 readwrite_gpg
($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput
=> 1);
344 readwrite_gpg
("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);