X-Git-Url: https://git.sthu.org/?a=blobdiff_plain;f=caff%2Fpgp-fixkey;h=48d47be19e717b581ea0c41822fb527eed90cd78;hb=fba02ab5cef2bfceaf97ee19d81af866854d54be;hp=ca00698cda2c8a22aa1a07fa32d48f8bc9f2cc15;hpb=4717f00e481e8f8d1acf51d35dc9afdaf6012b71;p=pgp-tools.git

diff --git a/caff/pgp-fixkey b/caff/pgp-fixkey
index ca00698..48d47be 100755
--- a/caff/pgp-fixkey
+++ b/caff/pgp-fixkey
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
-# caff  --  CA - Fire and Forget
-# $Id: caff 37 2005-02-28 23:20:15Z weasel $
+# pgp-fixkey  --  remove broken packets from keys
+# $Id$
 #
 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
 #
@@ -33,22 +33,21 @@
 
 =head1 NAME
 
-pgp-clean -- remove all non-self signatures from key
+pgp-fixkey -- remove broken packets from keys
 
 =head1 SYNOPSIS
 
 =over
 
-=item B<pgp-clean> I<keyid> [I<keyid> ...]
+=item B<pgp-fixkey> [I<keyid> [I<keyid> ...]]
 
 =back
 
 =head1 DESCRIPTION
 
-B<pgp-clean> takes a list of keyids on the command line and outputs an
-ascii-armored keyring on stdout for each key with all signatures except
-self-signatures stripped.  Its use is to reduce the size of keys sent out after
-signing (e.g. with B<caff>).
+B<pgp-fixkey> removes broken packets from keys in the GnuPG keyring that make
+GnuPG spew ugly warnings.  It optionally takes a list of keyids on the command
+line and only cleans those keys.
 
 =head1 OPTIONS
 
@@ -76,8 +75,6 @@ caff(1), gpg(1).
 
 Peter Palfrader <peter@palfrader.org>
 
-This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
-
 =cut
 
 use strict;
@@ -88,7 +85,7 @@ use Fcntl;
 use IO::Select;
 use GnuPG::Interface;
 
-my $REVISION = '$Rev: 37 $';
+my $REVISION = '$Rev$';
 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
 my $VERSION = "0.0.0.$REVISION_NUMER";
 
@@ -102,7 +99,7 @@ sub info($) {
 };
 sub debug($) {
 	my ($line) = @_;
-	print STDERR "[DEBUG] $line\n";
+	#print STDERR "[DEBUG] $line\n";
 };
 sub trace($) {
 	my ($line) = @_;
@@ -230,12 +227,11 @@ my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
 
 
 sub usage() {
-	print STDERR "pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n";
-	print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\n";
+	print STDERR "pgp-fixkey $VERSION - (c) 2004, 2005 Peter Palfrader\n";
+	print STDERR "Usage: $PROGRAM_NAME [<keyid> [<keyid> ...]]\n";
 	exit 1;
 };
 
-usage() unless scalar @ARGV >= 1;
 my @KEYIDS;
 for my $keyid (@ARGV) {
 	$keyid =~ s/^0x//i;
@@ -246,10 +242,38 @@ for my $keyid (@ARGV) {
 	push @KEYIDS, uc($keyid);
 };
 
+# find a list of all interesting keys.
+if (scalar @KEYIDS == 0) {
+	my $gpg = GnuPG::Interface->new();
+	$gpg->options->meta_interactive( 0 );
+	my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
+	$gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fast-list-mode', '--fixed-list-mode' ] );
+	my $pid = $gpg->list_sigs(handles => $handles);
+	my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
+	waitpid $pid, 0;
+	if ($stdout eq '') {
+		die ("No data from gpg for list-sigs\n");
+	};
+
+	my $thiskey = undef;
+	for my $line (split /\n/, $stdout) {
+		debug("Checking line $line");
+		my ($type, undef, undef, undef, $keyid, $created, undef, undef, undef, undef) = split /:/, $line;
+		if ($type eq 'pub') {
+			$thiskey = $keyid;
+			debug("Found key $thiskey");
+		} elsif (!defined $thiskey) {
+			next;
+		} elsif ($type eq 'sig' || $type eq 'rev') {
+			if (($keyid eq '0' x 16) || ($created eq "") || ($created == 0)) {
+				push @KEYIDS, $thiskey;
+				info("Key $thiskey needs cleaning.");
+				$thiskey = undef;
+			};
+		};
+	};
+}
 
-##################
-# export and prune
-##################
 KEYS:
 for my $keyid (@KEYIDS) {
 	# get key listing
@@ -267,7 +291,11 @@ for my $keyid (@KEYIDS) {
 	};
 	my $keyinfo = $stdout;
 	my @publine = grep { /^pub/ } (split /\n/, $stdout);
-	my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
+	if ($#publine < 0) {
+		warn ("No public key found for $keyid.\n");
+		next;
+	}
+	my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
 	my $can_encrypt = $flags =~ /E/;
 	unless (defined $longkeyid) {
 		warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
@@ -304,7 +332,7 @@ for my $keyid (@KEYIDS) {
 	debug("Parsing stdout output.");
 	for my $line (split /\n/, $stdout) {
 		debug("Checking line $line");
-		my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
+		my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
 		if ($type eq 'sub') {
 			$number_of_subkeys++;
 		};
@@ -330,9 +358,9 @@ for my $keyid (@KEYIDS) {
 		my $answer = "no";
 		if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
 			debug("[sigremoval] doing line $line.");
-			my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
-			if ($signer eq ('-1' x 16)) {
-				debug("[sigremoval] not interested in that sig ($signer).");
+			my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
+			if (($signer eq '0' x 16) || ($created == 0)) {
+				debug("[sigremoval] not interested in that sig ($signer, created: $created).");
 				$answer = "yes";
 			};
 		} else {