#!/usr/bin/perl

# Copyright (c) 2004 Uli Martens <uli@youam.net>
# Copyright (c) 2004 Peter Palfrader <peter@palfrader.org>
# Copyright (c) 2004 Christoph Berg <cb@df7cb.de>
#
# 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.
#
#
#
# Depends: 
# 	   libintl-perl (Locale::Recode)
# 	OR libtext-iconv-perl (Text::Iconv),
# 	OR the "recode" binary


use strict;
use warnings;
use File::Temp qw{tempdir};
use English;
use IPC::Open3;

my $r;
my $i;
if (eval "require Locale::Recode") {
	$r = Locale::Recode->new (from => 'UTF-8',
                             to   => 'ISO-8859-1');
} elsif (eval "require Text::Iconv") {
	$i = Text::Iconv->new("UTF-8", "ISO-8859-1");
}

sub myrecode($) {
	my ($text) = @_;
	if (defined $r) {
		my $orig = $text;
		$r->recode($text);
#printf STDERR "perl:  $orig to $text\n";
		return $text;
	} elsif (defined $i) {
		$text = $i->convert($text);
	} else {
		my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', 'utf8..iso8859-1');
		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;
#printf STDERR "manual:  $text to $result\n";
		return $result;
	};
}


my $EXPECTED_MD5 = '90 43 B8 1B';

my $mykey = uc(shift @ARGV);
my $keyring = shift @ARGV;
my $keytxt = shift @ARGV;
my $outfile = shift @ARGV;

$keyring = 'ksp-lt2k4.asc' unless defined $keyring;
$keytxt = 'ksp-lt2k4.txt' unless defined $keytxt;
$outfile = 'ksp-lt2k4-annotated.txt' unless defined $outfile;

if (!defined $mykey || scalar @ARGV || ($mykey !~ /^[0-9A-F]{16,16}$/  && $mykey !~ /^[0-9A-F]{8,8}$/)) {
	print STDERR "Usage: $PROGRAM_NAME keyid [<keyring> [<keytxt> [<outfile]]]\n";
	print STDERR "\n";
	print STDERR "keyid is a long or short keyid (e.g. DE7AAF6E94C09C7F or 94C09C7F\n";
	exit 1;
}

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


my $sigs;


my $tempdir = tempdir( "gpgsigs-XXXXX", DIR => '/tmp/', CLEANUP => 1);
$ENV{'GNUPGHOME'} = $tempdir;
print STDERR "Creating a temporary gnupghome and importing keys\n";
system(qw{gpg --import}, $keyring);

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

my $key;
my $uid;
while (<SIGS>) {
	if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
		$key = $1;
		next;
	}
	if ( m/^uid:(?:.*?:){8,8}(.*):/ ) {
		$uid = $1;
		$uid = myrecode($uid);
		next;
	}
	if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){3,3}(.*):.*?:/ ) {
		$sigs->{$key}->{$uid}->{$1.$2} = $3;
		$sigs->{$key}->{$uid}->{$2} = $3;
		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;

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


open MD, "gpg --print-md md5 $keytxt|" or warn "can't get gpg md5";
my $MD5 = <MD>;
close MD;
open MD, "gpg --print-md sha1 $keytxt|" or warn "can't get gpg sha1";
my $SHA1 = <MD>;
close MD;

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

if (defined $MD5) {
	warn ("md5 of $keytxt does not begin with $EXPECTED_MD5") unless ($MD5 =~ /^$EXPECTED_MD5/);
};

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>) {
	if (/^MD5 Checksum:  __ __ __ __ __ __ __ __    __ __ __ __ __ __ __ __/ && defined $MD5) {
		print WRITE "MD5 Checksum:  $MD5     [ ]\n";
	}
	elsif (/^SHA1 Checksum: ____ ____ ____ ____ ____    ____ ____ ____ ____ ____/ && defined $SHA1) {
		print WRITE "SHA1 Checksum: $SHA1   [ ]\n";
	} else {
		print WRITE;
	};
	if ( m/^([0-9]{3})  \[ \] Fingerprint OK        \[ \] ID OK$/ ) {
		$_ = <TXT>;
		if ( m/^pub  ( 768|1024|2048|4096)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} (.*)/ ) {
			my $l2 = $_;
			my $uid = $3;
			my $keyid = $2;
			if ( ! defined $sigs->{$keyid}->{$uid} ) {
				warn "uid '$uid' not found on key $keyid";
			};
			print WRITE ( defined $sigs->{$keyid}->{$uid}->{$mykey} ? "(S)" : "( )" );
			print WRITE "  $l2";
			$_ = <TXT>;
			print WRITE $_;
			while (<TXT>) {
				my $l3 = $_;
				if ( m/^uid     (.*)$/ ) {
					print WRITE defined $sigs->{$keyid}->{$1}
						? ( defined $sigs->{$keyid}->{$1}->{$mykey} ? "(S)" : "( )" )
						: "   ";
					print WRITE "  $l3";
				} else {
					print WRITE "$l3";
					last;
				}
			}
		} else {
			print WRITE "$_";
		}
	}
}
close TXT