#!/usr/bin/perl
# sigmatrix.pl - visualisation of signatures between keys
# 
# Copyright (C) 2003-2004, Daniel Roethlisberger <daniel@roe.ch>
# All rights reserved.
#
# Redistribution and use, with or without modification, are permitted
# provided that the following conditions are met:
# 1. Redistributions must retain the above copyright notice, this list of
#    conditions and the following disclaimer.
# 2. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# $Id: sigmatrix.pl,v 1.9 2004/03/13 13:57:32 roe Exp $

# $ ./sigmatrix.pl keyring.gpg
#  signator-->0         1         2
#  signee--v  012345678901234567890
# 89ABCDEF 00 sx xx     xxxx xxx xx 00 Hugo Meier <hugo@meier.net>
# 76543210 01  s    xxxx      xxxx  01 Sabine Suter <sabinesuter@freesurf.ch>
# 12345678 02 x s           xx    x 02 Daniel Roethlisberger <danielro@student.inf.ethz.ch>
#      ...                             ...

my $debug = 0;

# TODO
# - combine the two invocations of gpg into a single while loop
# - use gpg --with-colon for more robustness across different versions of
#   GnuPG
# - cater for unusual subkey types
# - correctly handle all cases of revoked signatures, including those where
#   multiple signatures and revocation packets are present
#   (hard! maybe have gpg do it for us?)

$myring = shift() or die "Usage: $0 ./keyring.gpg\n";

if($myring !~ /^\//) { $myring = './' . $myring; }

open GPG, "gpg --list-keys --no-default-keyring --keyring $myring|";

my %keys;

while(<GPG>)
{
	if(/^pub.*([0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]) [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9] (.*)/)
	{
		#pub  1024D/804A06B1 2002-07-04 Daniel Roethlisberger <daniel@roe.ch>
		$keys{$1} = $2 || '['.$1.']';
		print STDERR "key $1 $2\n" if($debug);
	}
}

close GPG;
# ugly!
open GPG, "gpg --list-sigs --no-default-keyring --keyring $myring|";

my @ids = sort keys %keys;
my %indices = {};
for(my $i = 0; $i <= $#ids; $i++)
{
	$indices{$ids[$i]} = $i;
}

my @sigs;
my $current = -1;

while(<GPG>)
{
	if(/^pub.*?([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} .*/)
	{
		#pub  1024D/804A06B1 2002-07-04 Daniel Roethlisberger <daniel@roe.ch>
		$current = $indices{$1};
	}
	elsif(/^uid +(.*)/)
	{
		#uid                            Daniel Roethlisberger <roe@cypherpunks.ch>
		# ignored
	}
	elsif(/^sig.*?([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} +.*/)
	{
		#sig 2  R    690B13F9 2003-06-11   Matthias Kestenholz (private) <bungle@gmx.ch>
		if(($current >= 0) && (defined $indices{$1}))
		{
			$sigs[$current][$indices{$1}] = 1 unless($sigs[$current][$indices{$1}]);
			print STDERR "sig to $ids[$current] from $1\n" if($debug);
		}
	}
	elsif(/^rev.*?([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} +.*/)
	{
		#rev         690B13F9 2003-06-11   Matthias Kestenholz (private) <bungle@gmx.ch>
		if(($current >= 0) && (defined $indices{$1}))
		{
			$sigs[$current][$indices{$1}] = 2;
			print STDERR "rev to $ids[$current] from $1\n" if($debug);
		}
	}
	elsif(/^sub/)
	{
		#sub  4096g/53D7E199 2002-07-04
		$current = -1;
	}
	else
	{
		# twiddle thumbs
	}
}

close GPG;

#  signator-->0         1         2...
print ' signator-->';
for(my $i = 0; $i <= $#ids; $i++)
{
	print ((!($i % 10)) ? (int($i / 10) % 10) : ' ');
}
print "\n";

#  signee--v  012345678901234567890...
print ' signee--v  ';
for(my $i = 0; $i <= $#ids; $i++)
{
	print $i % 10;
}
print "\n";

# 89ABCDEF 00 sx xx     xxxx xxx xx 00 Hugo Meier <hugo@meier.net>
# 76543210 01  s    xxxx      xxxx  01 Sabine Suter <sabinesuter@freesurf.ch>
# 12345678 02 x s           xx    x 02 Daniel Roethlisberger <danielro@student.inf.ethz.ch>
for(my $i = 0; $i <= $#ids; $i++)
{
	# 89ABCDEF 00 
	my $nn = ((($i % 100) < 10) ? '0' : '') . ($i % 100);
	print $ids[$i] . ' ' . $nn . ' ';
	# ----------->sx xx     xxxx xxx xx
	for(my $j = 0; $j <= $#ids; $j++)
	{
		print ($sigs[$i][$j] ? ($i == $j ? 's' : (($sigs[$i][$j] > 1) ? '!' : 'x')) : ' ');
	}
	# --------------------------------> 00 Hugo Meier <hugo@meier.net>
	print ' ' . $nn . ' ' . $keys{$ids[$i]} . "\n";
}

print <<EOF;

Legend:
 s Self-signature
 x Signature from \`signator' to \`signee'
 ! Revocation packets present - check manually!
EOF