#!/usr/bin/perl -w
#
# gpgsign: assistant for signing keys
#
# $dotat: scripts/gpgsign,v 1.27 2006/05/15 09:59:20 fanf2 Exp $

use strict;

use DB_File;
use Getopt::Long;

sub check_key ($);
sub command ($);
sub debugp ($@);
sub debugs ($&);
sub find_status ($);
sub ndebug ($&);
sub receive_email ();
sub sign_pending ();
sub poo ($);
sub shit ($);
sub shite ($);

use vars qw( %status %option );

my $self = 'Tony Finch <dot@dotat.at>';

my $dotdir = "$ENV{HOME}/.gnupg";
my $status = "$dotdir/sign-status";
my $message = "$dotdir/sign-message";

my $addr_re = '<?(\S+@[a-z0-9.-]+)';

########################################################################
#
#  Deal with the command line.
#

sub usage {
	die "usage:",
	    "	gpgsign [-df] keyid...\n",
	    "	gpgsign [-dfrs]\n",
	    "	-f	force various things to happen\n",
	    "	-r	handle a received email\n",
	    "	-s	do any pending signings\n",
	    "	-d	debug (may be specified more than once)\n",
	    "	by default, get a key from the key servers and\n",
	    "	send an email to its owner to confirm validity\n";
}

Getopt::Long::Configure 'bundling';
GetOptions (\%option, "debug|d+", "force|f!",
	    "print|p!", "receive|r!", "sign|s!")
    or usage;

$option{debug} ||= 0;

umask 0077;

tie %status, 'DB_File', $status,
    or shite "Could not open $status";

my %key2addrs;
my %key2cookies;
my %cookie2addr;
my %cookie2key;
my %addr2cookie;
my %total;
my %done;
my %ok;
for my $addr (sort keys %status) {
	debugp 1, $status{$addr};
	my @status = split /\t/, $status{$addr};
	shit "BAD STATUS!" unless $#status == 2 or $#status == 3;
	my $keyid = $status[0];
	debugp 2, "keyid $keyid";
	$addr2cookie{$addr} = $status[2];
	$cookie2addr{$status[2]} = $addr;
	$cookie2key{$status[2]} = $keyid;
	push @{$key2addrs{$keyid}}, $addr;
	push @{$key2cookies{$keyid}}, $status[2];
	$total{$keyid}++;
	$ok{$keyid} ||= 0;
	$done{$keyid} ||= 0;
	if ($#status == 3) {
		if ($status[3] eq 'OK') {
			$ok{$addr}++;
			$ok{$keyid}++;
			$ok{$status[2]}++;
		} elsif ($status[3] eq 'DONE') {
			$done{$addr}++;
			$done{$keyid}++;
			$done{$status[2]}++;
		} else {
			shit "BAD STATUS!";
		}
	}
}

if ($option{receive}) {
	usage if @ARGV;
	receive_email;
}

if ($option{sign}) {
	usage if @ARGV;
	sign_pending;
}

if (@ARGV) {
	check_key $_ for @ARGV;
}

untie %status;

exit;

########################################################################
#
#  Send out a key check
#

sub check_key ($) {
	my $keyid = shift;
	my $yn;

	my $fingerprint = command "gpg --fingerprint $keyid";
	if (not defined $fingerprint) {
		0 == system "gpg --recv-keys $keyid"
		    or shit "Could not get key from server";
		$fingerprint = command "gpg --fingerprint $keyid"
		    or shit "Could not display fingerprint";
	}

	$fingerprint =~ /.*?fingerprint = ([0-9a-f ]+).*/si;
	my $longid = $1;
	my $gpgid = $1;
	$gpgid =~ s/ //g;

	print $fingerprint, $longid, "\nIs this the right key?\n";
	$yn = <STDIN>;
	shit "Aborting." unless $yn =~ m/^(y|yes)$/i;

	my %addresses;

	if (defined $key2addrs{$longid}) {
		for my $addr (@{$key2addrs{$longid}}) {
			$addresses{$addr} = 1
			    if $option{force} or
			    not ($done{$addr} or $ok{$addr});
		}
		my $addrs = join " ", keys %addresses;
		print "Re-send challenges to $addrs?\n";
		$yn = <STDIN>;
		shit "Aborting." unless $yn =~ m/^(y|yes)$/i;
	} else {
		for my $line (split /\n/, $fingerprint) {
			debugp 2, "fingerprint line $line";
			$addresses{$1} = 1
			    if $line =~ /^uid +(.*)/;
		}
		debugp 1, "Email addresses:\n", map "$_\n", keys %addresses;
	}

	for my $address (keys %addresses) {
		$address =~ /$addr_re/io;
		my $addr = $1;
		my $cookie = $addr2cookie{$addr};
		unless (defined $cookie) {
			$cookie = command "dd if=/dev/random count=1 2>/dev/null | md5"
			    or shit "Could not get a cookie";
			chomp $cookie;
		}
		my $status = "$longid\t$address\t$cookie";
		debugp 1, $status;
		print "Preparing message for: $address\n";

		open MESSAGE, "> $message"
		    or shite "open > $message";
		print MESSAGE <<HERE_ENDETH;
From: $self
To: $address
CC: $self
Subject: Key signing formalities

You have been sent this email because we exchanged PGP/GPG key
fingerprints at some point in the past. There are some instructions
in the encrypted block below which you need to follow to complete
the process. Apologies for the formality; it is because this is
mostly being done automatically. Pay no attention to the man behind
the curtain.

$self

HERE_ENDETH
		close MESSAGE or shite "writing to $message";

		open GPG, "| gpg --encrypt --sign --armor --always-trust --recipient $gpgid >> $message"
		    or shite "open | gpg";
		print GPG <<HERE_ENDETH;

This message is part of my key verification process.
It is to verify that you, the holder of the key
	$longid
can read email sent to the address
	$address
You should receive separate messages containig different cookies
for each address in your key.

Now that you have decrypted this message, please send a reply to me
in plaintext (unencrypted) quoting the following string:
	$cookie
When I have received all the replies I will sign your key.

$self

HERE_ENDETH
		close GPG or shit "gpg failed!";

		debugs 2, sub { system "cat $message" };
		ndebug 3, sub {
			0 == system "sendmail -t < $message"
			    or shit "Failed to send mail to $address";
			$status{$addr} = $status;
		};
		unlink $message;
	}
}

########################################################################
#
#  Receive an email
#

sub receive_email () {
	my $ok;
	while (<>) {
		debugp 2, "read $_";
		for my $cookie (keys %cookie2key) {
			debugp 2, "looking for $cookie";
			next unless /\b$cookie\b/;
			debugp 2, "Found";
			my $addr = $cookie2addr{$cookie};
			poo "No address for cookie?!" unless defined $addr;
			debugp 1, "$cookie -> $addr";
			if (not exists $status{$addr}) {
				poo "No status for address?!";
			} elsif ($status{$addr} =~ /\tDONE$/) {
				debugp 1, "Already signed";
			} elsif ($status{$addr} =~ /\tOK$/) {
				debugp 1, "Already seen";
			} else {
				$status{$addr} .= "\tOK";
				$ok++;
			}
		}
	}
	shit "Couldn't find a valid cookie!" unless $ok;
}

########################################################################
#
#  Look for any pending signs that we can do
#

sub sign_pending () {
	for my $keyid (keys %total) {
		debugp 1, "$keyid total=$total{$keyid} ok=$ok{$keyid}";
		debugp 1, "@{$key2addrs{$keyid}}";
		next unless $total{$keyid} == $ok{$keyid}
		    or $option{force} and $ok{$keyid};
		poo $status{$_} for @{$key2addrs{$keyid}};
		my $gpgid = $keyid;
		$gpgid =~ s/ //g;
		0 == system "gpg --sign-key $gpgid"
		    or shit "gpg failed!";
		0 == system "gpg --send-keys $gpgid"
		    or shit "gpg failed!";
		my $address;
		for my $addr (@{$key2addrs{$keyid}}) {
			ndebug 3, sub {
				$status{$addr} =~ s/\tOK$/\tDONE/
					or next;
				debugp 1, $status{$addr};
				$address = $1 if not defined $address
				    and $status{$addr} =~ /\t([^\t]+)\t/;
			};
		}
		shit "No email address!" unless defined $address;

		open MESSAGE, "> $message"
		    or shite "open > $message";
		if ($total{$keyid} == $ok{$keyid}) {
			print MESSAGE <<HERE_ENDETH;
From: $self
To: $address
CC: $self
Subject: Key signing formalities completed

I've successfully received replies to all of my email probes so I have
signed your key. As well as attaching it to this message, I have uploaded
it to the key server network. Thanks for exchanging signatures with me!

$self

HERE_ENDETH
		} else {
			print MESSAGE <<HERE_ENDETH;
From: $self
To: $address
CC: $self
Subject: Key signing formalities completed

I've successfully received some replies to my email probes so I have
signed the corresponding identities in your key. As well as attaching
it to this message, I have uploaded it to the key server network.
Thanks for exchanging signatures with me!

$self

HERE_ENDETH
		}
		close MESSAGE or shite "writing to $message";
		0 == system "gpg --export --armor $gpgid >> $message"
		    or shit "gpg failed!";
		debugs 2, sub { system "cat $message" };
		ndebug 3, sub {
			0 == system "sendmail -t < $message"
			    or shit "Failed to send mail to $address";
		};
		unlink $message;
	}
}

########################################################################
#
#  Run a command and return the output
#

sub command ($) {
	my $cmd = shift;
	my $out = `$cmd 2>&1`;
	if ($?) {
		print STDERR $out;
		return undef;
	} else {
		return $out;
	}
}

########################################################################
#
#  Debugging and error handling
#

sub debugp ($@) {
	return if not defined $main::option{debug}
	    or $main::option{debug} < shift;
	print STDERR @_, "\n";
}

sub debugs ($&) {
	return if not defined $main::option{debug}
	    or $main::option{debug} < shift;
	&{$_[0]};
}

sub ndebug ($&) {
	return if defined $main::option{debug}
	    and $main::option{debug} >= shift;
	&{$_[0]};
}

sub poo ($) {
	warn "@_\n";
}

sub shit ($) {
	die "@_\n";
}

sub shite ($) {
	die "@_: $!\n";
}

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