#!/usr/bin/perl

# keyparty 1.1 (2003/10/12)
#
# Copyright (C) 2003 Patrick Bernier <pat@TZoNE.ORG>
# All rights reserved
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
#
# Get the latest version at http://www.TZoNE.ORG/~pat/sw/
#
# KNOWN BUGS:
# - Won't deal with more than one picture UID per key
#
# TODO:
# - Show key creation date, expiration date
# - Commandline switch to provide the title
# - Usage message
# - Output currently sorted by keyring order. Re-sort?

use strict;
use warnings;

use POSIX qw(strftime);
use CGI qw(escapeHTML);

###############################################################################

my $VERSION = '1.1';

my $TITLE = 'An unnamed keysigning event';
my $EMAIL = 'sink@TZoNE.ORG';

my $GPGPATH = 'gpg';
my $MAXPICSIZE = 65536;

###############################################################################

# Self-call while getting pictures
if (@ARGV == 3 && $ARGV[0] eq '--getpic') {
	getpic();
	exit 0;
}

# Get keyspecs from commandline and STDIN
my @keyspecs;
unshift @keyspecs, <STDIN> unless (-t 0);
unshift @keyspecs, @ARGV;
chomp @keyspecs;

# Feed keyspecs to gpg using xargs to split up invocations as needed
if (open(XARGS, "-|") == 0) {
	if (open(STDIN, "-|") == 0) {
		print "@keyspecs" or die "feeding keyspecs: $!";
		exit 0;
	} else {
		exec 'xargs', '-r', '--', $GPGPATH,
			'--batch',
			'--fixed-list-mode',
			'--with-colons',
			'--list-keys',
			'--with-fingerprint',
			'--with-fingerprint' # twice to get subkey fingerprints
			or die "exec xargs: $!";
	}
}

# Close stdout to get rid of gpg output from --getpic calls
open OUTPUT, ">&1" or die "cannot dup stdout: $!";
close STDOUT or die "closing stdout: $!";

# Parse the results
my $keycount = 0;
my $lasttype;
my $key = undef;
while (<XARGS>) {
	chomp;
	my @v = split /:/;
	SWITCH: for ($v[0]) {
		/^pub$/ && do {
			if ($keycount++) {
				describe($key);
			} else {
				header();
			}
			undef $key;
			$lasttype = 'pub';
			$key->{'trust'} = $v[1];
			$key->{'id'} = $v[4];
			$key->{'len'} = $v[2];
			$key->{'algo'} = $v[3];
			$key->{'created'} = $v[5];
			$key->{'expires'} = $v[6];
			$key->{'uid'} = [ ];
			$key->{'uat'} = [ ];
			last SWITCH;
		};
		/^sub$/ && do {
			$lasttype = 'sub';
			last SWITCH;
		};
		/^fpr$/ && do {
			$key->{'fp'} = $v[9] if ($lasttype eq 'pub');
			last SWITCH;
		};
		/^uid$/ && do {
			push @{$key->{'uid'}}, $v[9]
				unless ($v[1] =~ /^(i|d|r|e)$/);
				# invalid/disabled/revoked/expired
			last SWITCH;
		};
		/^uat$/ && do {
			push @{$key->{'uat'}}, $v[9];
			last SWITCH;
		};
	}
}
describe($key);	# describe the last key

footer();

close XARGS or warn "close xargs: $!";

exit 0; # all done

###############################################################################

sub describe {
	my $key = shift;

	# Get first picture ID if any
	if (@{$key->{'uat'}} > 0) {
		system $GPGPATH, '--batch', '--show-photos', '--photo-viewer',
			"$0 --getpic \%f \%t", '--list-keys', $key->{'fp'};
	}

	# Format the fingerprints in the traditional fashion
	my $f_fp = $key->{'fp'};
	if (length($f_fp) == 32) {
		$f_fp =~ s/(..)/$1 /g;
		$f_fp =~ s/\s$//;
		substr $f_fp, 23, 1, "<br />";
	} elsif (length($f_fp) == 40) {
		$f_fp =~ s/(....)/$1 /g;
		$f_fp =~ s/\s$//;
		substr $f_fp, 24, 1, "<br />";
	}

	print OUTPUT << "EOT";
 <tr><td colspan="4" class="line"></td></tr>
 <tr>
  <td class="fp">$key->{'id'}</td>
  <td class="fp" colspan="2">$f_fp</td>
  <td class="c">Fingerprint?</td>
 </tr>
EOT

	my $picfn = "$key->{'fp'}.jpeg";
	my $firstuid = escapeHTML(shift @{$key->{'uid'}});
	if (-f $picfn) {
		my $picsize = -s $picfn;
		my $rowspan = 2 + @{$key->{'uid'}};
		print OUTPUT << "EOT";
 <tr>
  <td rowspan="$rowspan" align="center" valign="middle"><img src="$picfn"
   alt="photo uid" /></td>
  <td colspan="2" class="uid">&lt; &lt; &lt; [image of size $picsize]</td>
  <td class="c">Picture?</td>
 </tr>
 <tr>
  <td class="uid">$firstuid</td>
  <td class="c">Name?</td>
  <td class="c">Address?</td>
 </tr>
EOT
	} else {
		my $rowspan = 1 + @{$key->{'uid'}};
		print OUTPUT << "EOT";
 <tr>
  <td rowspan="$rowspan"><em>No&nbsp;picture</em></td>
  <td class="uid">$firstuid</td>
  <td class="c">Name?</td>
  <td class="c">Address?</td>
 </tr>
EOT
	}
	foreach my $uid (@{$key->{'uid'}}) {
		my $f_uid = escapeHTML($uid);
		print OUTPUT << "EOT";
 <tr>
  <td class="uid">$f_uid</td>
  <td class="c">Name?</td>
  <td class="c">Address?</td>
 </tr>
EOT
	}

}

###############################################################################

sub getpic {
	my $fp = $ARGV[1];
	my $ext = $ARGV[2];
	$ext =~ s/^jpg$/jpeg/;
	my $pic;
	(my $br = read STDIN, $pic, $MAXPICSIZE) or die "reading picture: $!";
	if ($br >= $MAXPICSIZE) {
		print STDERR "Picture ID too big\n";
		exit 1;
	}
	open PIC, ">$fp.$ext" or die "creating picture file $fp.$ext : $!";
	print PIC $pic or die "writing picture file : $!";
	close PIC or warn "closing pic: $!";
}

###############################################################################

sub header {
print OUTPUT << "EOT";
<!DOCTYPE html 
	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
	"DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">

<head>
 <title>$TITLE</title>
 <style type="text/css">
 <!--
 	h1 {
		font-size: 18px;
	}
 	td {
		font-size: 14px;
	}
	td.fp {
		font-family: monospace;	/* make fingerprints easy to read */
		font-weight: bold;
	}
	td.c {
		width: 50px;		/* make checkboxes big enough */
		height: 30px;
		vertical-align: top;	/* and their labels small */
		font-size: 9px;
	}
	td.uid {
		/* nil */
	}
	td.line {
		height: 5px;		/* separator */
	}
	address {
	 	font-size 10px;
	}
 -->
 </style>
</head>

<body bgcolor="#ffffff">

<h1>$TITLE</h1>

<p><a href="mailto:$EMAIL">E-mail me</a> to be added to this list.</p>

<table border="1" cellspacing="0" cellpadding="3">
EOT
}

###############################################################################

sub footer {
	my $now = strftime('%Y/%m/%d', localtime());
	print OUTPUT << "EOT";
</table>

<address>
 Generated on $now using <a href="http://www.TZoNE.ORG/~pat/sw/">keyparty</a>
 $VERSION<br />
</address>

</body>
</html>
EOT

}

__END__

### keyparty ##################################################################