#!/usr/bin/perl

# $Id$

# See the pod documentation at the end of this file for author,
# copyright, and licence information.
#
# Depends: 
# 	   libintl-perl (Locale::Recode)
# 	OR libtext-iconv-perl (Text::Iconv),
# 	OR the "recode" binary
#
# Changelog:
# 0.1
# 0.2 2005-05-14 cb:
#   * use the user's normal keyring to find signatures
#   * support for multiple user keys
#   * better charset conversion
#   * pod documentation
# see the Debian changelog for further changes.

my $VERSION = qq$Rev$;
$ENV{PATH} .= ":/usr/share/signing-party";

use strict;
use warnings;
use English;
use IPC::Open3;
use Getopt::Long;


sub version($)
{
	my ($fd) = @_;

	print $fd <<EOF;
gpgsigs $VERSION- http://pgp-tools.alioth.debian.org/
  (c) 2004 Uli Martens <uli\@youam.net>
  (c) 2004, 2005 Peter Palfrader <peter\@palfrader.org>
  (c) 2004, 2005, 2006, 2007 Christoph Berg <cb\@df7cb.de>
EOF
}

sub usage($$)
{
	my ($fd, $error) = @_;

	version($fd);
	print $fd <<EOF;

Usage: $PROGRAM_NAME [-r] [-t <charset>] <keyid> <keytxt> [<outfile>]

keyid is a long or short keyid (e.g. DE7AAF6E94C09C7F or 94C09C7F)
separate multiple keyids with ','
-r            call gpg --recv-keys before proceeding
-f <charset>  convert <keytxt> from charset
-t <charset>  convert UIDs to charset in output
--refresh     regenerate UID lists on keys
--latex       generate LaTeX output including photo IDs
EOF
	exit $error;
}


my ($fromcharset, $charset, $recv_keys, $refresh, $latex);
Getopt::Long::config('bundling');
GetOptions(
	'-f=s' => \$fromcharset,
	'-t=s' => \$charset,
	r => \$recv_keys,
	refresh => \$refresh,
	latex => \$latex,
	help => sub { usage(*STDOUT, 0); },
	version => sub { version(*STDOUT); exit 0;},
) or usage(*STDERR, 1);


# charset conversion
$fromcharset ||= "ISO-8859-1";
$charset ||= $ENV{LC_ALL} || $ENV{LC_CTYPE} || $ENV{LANG} || "ISO-8859-1";
$charset = "ISO-8859-1" unless $charset =~ /[\.-]/;
$charset =~ s/.*\.//;
$charset =~ s/@.*//;
 

sub myrecode($$$) {
	my ($text, $from, $to) = @_;

	if (eval "require Locale::Recode") {
		my $rt = Locale::Recode->new (from => $from, to => $to);

		my $orig = $text;
		$rt->recode($text);
		return $text;
	} elsif (eval "require Text::Iconv") {
		my $it = Text::Iconv->new($from, $to);

		my $result = $it->convert($text);
		warn ("Could not convert '$text'\n") unless defined $result;
		return (defined $result) ? $result : $text
	} else {
		my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "utf8..$charset");
		print WTRFH $text;
		close WTRFH;
		local $/ = undef;
		my $result = <RDRFH>;
		close RDRFH;
		close ERRFH;
		waitpid $pid, 0;
		warn ("'recode' failed, is it installed?\n") unless defined $result;
		return (defined $result) ? $result : $text
	}
}


# parse options
my @mykeys = split /,/, uc(shift @ARGV);
my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
my $outfile = (shift @ARGV) || '-';

map { s/^0x//i; } @mykeys;
my %uids = map { $_ => [] } @mykeys;

if (!@mykeys || scalar @ARGV) {
	usage(*STDERR, 1);
}
foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
	print STDERR "Invalid keyid $falsekey given\n";
	usage(*STDERR, 1);
}

-r $keytxt or die ("$keytxt does not exist\n");


# get list of keys in file
my @keys;
open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
while (<TXT>) {
	if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
		push @keys, $1;
	}
}
close TXT;


# get all known signatures
if ($recv_keys) {
	print STDERR "Requesting keys from keyserver\n";
	system "gpg --recv-keys @keys";
}

print STDERR "Running --list-sigs, this will take a while ";
open SIGS, "gpg --fixed-list-mode --with-colons --list-sigs @mykeys @keys 2>/dev/null |"
	or die "can't get gpg listing";

my ($key, $uid, $sigs, $photocount);
while (<SIGS>) {
	if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
		$key = $1;
		print STDERR ".";
		undef $photocount;
		next;
	}
	if ( m/^uid:(.):(?:.*?:){7,7}(.*):/s ) {
		my $uidstatus = $1;
		$uid = $2;
		$uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
		$uid = myrecode($uid, "UTF-8", $charset);

		my ($shortkey) = substr $key, -8;
		# Remember non-revoked uids
		next if $uidstatus eq "r";
		push @{$uids{$shortkey}}, $uid;
		next;
	}
	if ( m/^uat:(.)::::[^:]+::([0-9A-F]+)::\d+ (\d+)/ ) { # uat:-::::2006-08-03::27BAEAF742BD253C2F3F03B043DC1536880193C4::1 7993:
		my $uidstatus = $1;
		# $2 is hash of attribute data
		my $size = $3 - 19; # FIXME: find a nicer way to find out picture size
		$uid = "[jpeg image of size $size]";
		next if $uidstatus eq "r";
		if ($latex and not $photocount) { # call once per key
			my ($shortkey) = substr $key, -8;
			system "rm -f $shortkey.[1-9]*.eps";
			system "gpg --photo-viewer 'gpgsigs-eps-helper $shortkey' --list-options show-photos --list-key $key > /dev/null";
			$photocount = 1;
		}
		my ($shortkey) = substr $key, -8;
		push @{$uids{$shortkey}}, $uid;
		next;
	}
	if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
		my $class = $3;
		if ($class eq '10x') {
			$class = 'S';
		} elsif ($class eq '11x') {
			$class = '1';
		} elsif ($class eq '12x') {
			$class = '2';
		} elsif ($class eq '13x') {
			$class = '3';
		} else {
			$class = 's';
		};
		# Handle the case where one UID was signed multiple times
		# with different signature classes.
		my $before = $sigs->{$key}->{$uid}->{$1.$2};
		if (defined $before) {
			if ($before eq 'S' || $before eq 's') {
				$sigs->{$key}->{$uid}->{$1.$2} = $class;
			} elsif ($class eq 'S' || $class eq 's') {
				# intentionally left blank
			} elsif ($before < $class) {
				$sigs->{$key}->{$uid}->{$1.$2} = $class;
			};
		} else {
			$sigs->{$key}->{$uid}->{$1.$2} .= $class;
		};
		$sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
		next;
	}
	next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
	warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
}
close SIGS;
print STDERR "\n";

for my $k ( keys %{$sigs} ) {
	if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
		$sigs->{$1} = $sigs->{$k};
	}
}


# read checksums
open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
my $MD5 = <MD>;
close MD;
open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
my $SHA1 = <MD>;
close MD;
open MD, "gpg --with-colons --print-md sha256 $keytxt|" or warn "can't get gpg sha256\n";
my $SHA256 = <MD>;
close MD;
open MD, "gpg --with-colons --print-md ripemd160 $keytxt|" or warn "can't get gpg ripemd160\n";
my $RIPEMD160 = <MD>;
close MD;

my @MD5 = split /:/, $MD5;
my @SHA1 = split /:/, $SHA1;
my @SHA256 = split /:/, $SHA256;
my @RIPEMD160 = split /:/, $RIPEMD160;
$MD5 = $MD5[2];
$SHA1 = $SHA1[2];
$SHA256 = $SHA256[2];
$RIPEMD160 = $RIPEMD160[2];

$MD5 =~ s/(.{16})/$1 /;
$SHA1 =~ s/(.{20})/$1 /;
$SHA256 =~ s/(.{32})/$1 /;
$RIPEMD160 =~ s/(.{20})/$1 /;
$MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
$SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
$SHA256 =~ s/([0-9A-Z]{4})/$1 /ig;
$RIPEMD160 =~ s/([0-9A-Z]{4})/$1 /ig;

chomp $MD5;
chomp $SHA1;
chomp $SHA256;
chomp $RIPEMD160;
my $metatxt = quotemeta($keytxt);
$MD5 =~ s/^$metatxt:\s*//;
$SHA1 =~ s/^$metatxt:\s*//;
$SHA256 =~ s/^$metatxt:\s*//;
$RIPEMD160 =~ s/^$metatxt:\s*//;


# write out result
sub print_tag
{
	my ($key, $uid) = @_;
	if (! defined $sigs->{$key}->{$uid}) {
		warn "uid '$uid' not found on key $key\n";
		#for (keys %{ $sigs->{$key} }) {
		#	print STDERR "only have $_\n";
		#};
		return '(' . (' ' x @mykeys) . ')';
	}
	my $r = '(';
	foreach my $mykey (@mykeys) {
		$r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
	}
	$r .= ')';
	return $r;
}

$key = undef;
$uid = undef;
my $line = 0;
my $keys = 0;
print STDERR "Annotating $keytxt, writing into $outfile\n";
open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
open (WRITE, '>'.$outfile) or die ("Cannot open $outfile for writing\n");

if ($latex) {
	print WRITE <<'EOF';
\documentclass{article}
\usepackage[margin=2cm]{geometry}
\usepackage{alltt}
\usepackage{graphicx}
\usepackage{grffile}
\begin{document}
\begin{alltt}
EOF
}

while (<TXT>) {
	$line++;
	$_ = myrecode($_, $fromcharset, $charset);
	if (/^MD5 Checksum:/ && defined $MD5) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
	}
	if (/^SHA1 Checksum:/ && defined $SHA1) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
	}
	if (/^SHA256 Checksum:/ && defined $SHA256) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA256/;
	}
	if (/^RIPEMD160 Checksum:/ && defined $RIPEMD160) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$RIPEMD160/;
	}

	if ( m/^[0-9]+\s+\[ \] Fingerprint OK/ ){
		if ($latex) {
			if ($keys > 0) {
				print WRITE "\\end{samepage}\n";
			}
			print WRITE "\\begin{samepage}\n";
			++$keys;
		}
		print WRITE;
		next;
	}

	if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
		$key = $1;
		$uid = $2;
		#if ($uid) { # in gpg 1.2, the first uid is here
		#	print WRITE print_tag($key, $uid) . " $_";
		#	next;
		#}
		print WRITE;
		undef $photocount;
		next;
	}

	if ( m/^ *Key fingerprint/ ) {
		print WRITE;
		my $inc = "";
		foreach my $mykey (@mykeys) {
			foreach my $myuid (@{$uids{$mykey}}) {
				$inc .= defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
			}
		}
		print WRITE "[$inc] incoming signatures\n" if $inc =~ /\S/;
		if ($refresh or $latex) {
			foreach $uid (@{$uids{$key}}) {
				print WRITE print_tag($key, $uid) . " $uid\n";
				if ($latex and ($uid =~ /^\[jpeg image/)) {
					$photocount++;
					print WRITE "\\begin{flushright}\n";
					print WRITE "\\includegraphics[height=3cm]{$key.$photocount}\n";
					print WRITE "\\end{flushright}\n";
				}
			}
		}
		next;

	}
	if ( m/^uid +(.*)$/ ) {
		$uid = $1;
		next if $refresh or $latex;
		unless (defined $key) {
			warn "key is undefined - input text is possibly malformed near line $line\n";
			next;
		};
		die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
		print WRITE print_tag($key, $uid) . " $_";
		next;
	}
	print WRITE;
}

if ($latex && ($keys > 0)) {
	print WRITE "\\end{samepage}\n";
}

print WRITE "Legend:\n";
my $num_myuids = 0;
foreach my $i (0 .. @mykeys - 1) {
	print WRITE '(' . ' 'x$i . 'S' . ' 'x(@mykeys-$i-1) . ") signed with $mykeys[$i] $uids{$mykeys[$i]}->[0]\n";
	$num_myuids += @{$uids{$mykeys[$i]}};
}
my $i = 0;
foreach my $mykey (@mykeys) {
	foreach my $myuid (@{$uids{$mykey}}) {
		my $inc = defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
		print WRITE "[" . ' 'x$i . 'S' . ' 'x($num_myuids-$i-1) . "] has signed $mykey $myuid\n";
		$i++;
	}
}
close TXT;

if ($latex) {
	print WRITE <<'EOF';
\end{alltt}
\end{document}
EOF
}

close WRITE;

__END__

=head1 NAME

B<gpgsigs> - annotate list of GnuPG keys with already done signatures

=head1 SYNOPSIS

B<gpgsigs> [I<options>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]

=head1 DESCRIPTION

B<gpgsigs> was written to assist the user in signing keys during a keysigning
party. It takes as input a file containing keys in C<gpg --list-keys> format
and prepends every line with a tag indicating if the user has already signed
that uid. When the file contains C<ALGO Checksum:> lines and placeholders
(C<__ __>), the checksum is inserted. ALGO can be set to the following algorithms:
MD5 SHA1 SHA256 or RIPEMD160.

=head1 OPTIONS

=over

=item B<-r>

Call I<gpg --recv-keys> before creating the output.

=item B<-f> I<charset>

Convert F<keytxt> from I<charset>. The default is ISO-8859-1.

=item B<-t> I<charset>

Convert UIDs to I<charset>. The default is derived from LC_ALL, LC_CTYPE, and
LANG, and if all these are unset, the default is ISO-8859-1.

=item B<--refresh>

Refresh the UID lists per key from gpg. Useful when UIDs were added or revoked
since the input text was generated.

=item B<--latex>

Generate LaTeX output, including photo IDs. Implies B<--refresh>.
B<Note:> This writes eps files to the current directory.

=item I<keyid>

Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
by a comma (B<,>).

=item F<keytxt>

Read input from F<keytxt>.

=item F<outfile>

Write output to F<outfile>. Default is stdout.

=back

=head1 EXAMPLES

The following key signing parties are using B<gpgsigs>:

http://www.palfrader.org/ksp-lt2k4.html

http://www.palfrader.org/ksp-lt2k5.html

=head1 BUGS

B<GnuPG> is known to change its output format quite often. This version has
been tested with gpg 1.2.5 and gpg 1.4.1. YMMV.

=head1 SEE ALSO

gpg(1), caff(1).

http://pgp-tools.alioth.debian.org/

=head1 AUTHORS AND COPYRIGHT

(c) 2004 Uli Martens <uli@youam.net>

(c) 2004, 2005 Peter Palfrader <peter@palfrader.org>

(c) 2004, 2005, 2006, 2007 Christoph Berg <cb@df7cb.de>

=head1 LICENSE

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

3. 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.