#!/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

my $VERSION = qq$Rev$;

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 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
EOF
	exit $error;
}


my ($fromcharset, $charset, $recv_keys);
Getopt::Long::config('bundling');
GetOptions(
	'-f=s' => \$fromcharset,
	'-t=s' => \$charset,
	r => \$recv_keys,
	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/@.*//;
 
my ($rf, $rt, $if, $it);
if (eval "require Locale::Recode") {
	$rf = Locale::Recode->new (from => $fromcharset, to => $charset) if $fromcharset;
	$rt = Locale::Recode->new (from => 'UTF-8', to => $charset);
} elsif (eval "require Text::Iconv") {
	$if = Text::Iconv->new($fromcharset, $charset) if $fromcharset;
	$it = Text::Iconv->new("UTF-8", $charset);
}

sub myfromrecode($) {
	my ($text) = @_;
	if (defined $rf) {
		my $orig = $text;
		$rf->recode($text);
		return $text;
	} elsif (defined $if) {
		return $if->convert($text);
	} else {
		my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "$fromcharset..$charset");
		print WTRFH $text;
		close WTRFH;
		local $/ = undef;
		my $result = <RDRFH>;
		close RDRFH;
		close ERRFH;
		waitpid $pid, 0;
		die ("'recode' failed, is it installed?\n") unless defined $result;
		return $result;
	}
}

sub myrecode($) {
	my ($text) = @_;
	if (defined $rt) {
		my $orig = $text;
		$rt->recode($text);
		return $text;
	} elsif (defined $it) {
		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 $mykey = uc(shift @ARGV);
my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
my $outfile = (shift @ARGV) || '-';

my @mykeys = split /,/, $mykey;
map { s/^0x//i; } @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 @keys 2>/dev/null |"
	or die "can't get gpg listing";

my ($key, $uid, $sigs);
while (<SIGS>) {
	if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
		$key = $1;
		print STDERR ".";
		next;
	}
	if ( m/^uid:(?:.*?:){8,8}(.*):/s ) {
		$uid = myrecode($1);
		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';
		};
		$sigs->{$key}->{$uid}->{$1.$2} = $class;
		$sigs->{$key}->{$uid}->{$2} = $class;
		next;
	}
	if ( m/^uat:/ ) {
		$uid = "Photo ID";
		next;
	}
	next if ( m/^(rev|sub|tru):/ );
	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 --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
my $MD5 = <MD>;
close MD;
open MD, "gpg --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
my $SHA1 = <MD>;
close MD;

chomp $MD5;
chomp $SHA1;
my $metatxt = quotemeta($keytxt);
$MD5 =~ s/^$metatxt:\s*//;
$SHA1 =~ 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";
		return '(' . (' ' x @mykeys) . ')';
	}
	my $r = '(';
	foreach my $mykey (@mykeys) {
		$r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
	}
	$r .= ')';
	return $r;
}

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");
while (<TXT>) {
	$_ = myfromrecode($_);
	if (/^MD5 Checksum:/ && defined $MD5) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
	}
	if (/^SHA1 Checksum:/ && defined $SHA1) {
		s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
	}
	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;
		#}
	}
	if ( m/^uid +(.*)$/ ) {
		$uid = $1;
		die "key is undefined" unless defined $key;
		die "uid is undefined, key $key" unless defined $uid;
		die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
		print WRITE print_tag($key, $uid) . " $_";
		next;
	}
	print WRITE;
}

print WRITE "Legend:\n";
foreach my $i (0 .. @mykeys - 1) {
	print WRITE '('. ' 'x$i . 'S' . ' 'x(@mykeys-$i-1) . ") signed with $mykeys[$i]\n";
}
close TXT;

__END__

=head1 NAME

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

=head1 SYNOPSIS

B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] 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<MD5 Checksum:> or C<SHA1 Checksum:> lines
and placeholders (C<__ __>), the checksum is inserted.

=head1 OPTIONS

=over

=item -r

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

=item -f I<charset>

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

=item -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 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 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.