#!/usr/bin/perl
# signkey.pl
# $Id: signkey.pl 431 2005-01-06 21:00:53Z scott $
#
# Sign each UID of a key individually, mailing the exported version
# encrypted to the e-mail address given.
#
# Copyright (C) 2003 Scott James Remnant <scott@netsplit.com>.
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL SOFTWARE IN THE PUBLIC INTEREST, INC. BE LIABLE FOR
# ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

$name = $ENV{DEBFULLNAME};
$mail = $ENV{DEBEMAIL};
unless ($name && $mail) {
	print STDERR "DEBFULLNAME and DEBEMAIL environment variables not set\n";
	exit 1
}

if ($ARGV[0] && -f $ARGV[0]) {
	open KEYS, $ARGV[0];
	@keys = <KEYS>;
	foreach (@keys) { chomp; }
	close KEYS;
} else {
	@keys = @ARGV;
}

unless (@keys) {
	print STDERR "Usage: $0 < FILENAME | KEYS... >\n\n";
	print STDERR "FILENAME  newline separated list of key information\n";
	print STDERR "KEYS      key information\n";
	exit 1;
}

@gpg = ("gpg", "--no-auto-check-trustdb", "--batch", "--yes", "--armor",
	"--always-trust");
$gpg = join(" ", @gpg);

system "stty -echo";
print "GPG Passphrase: ";
$pass = <STDIN>;
system "stty echo";
print "\n";

foreach $key (@keys) {
	print "*" x 80, "\n";
	eval { &sign_key($key); };
	if ($@) {
		print STDERR "*** Error processing $key\n";
		print STDERR "$@\n";
	}
	print "*" x 80, "\n\n\n";
}
system("gpg", "--check-trustdb");

sub sign_key {
	my $key = shift;

	$id = undef;
	$fpr = undef;
	$expiry = undef;
	@uid = ();

	# suggestion by moray, not a problem if it doesn't work

	foreach $cmd ("", "recv") {
		system(@gpg, "--recv-keys", $key) if $cmd eq "recv";

		open KEYINFO, "$gpg --fixed-list-mode --with-colons " .
			      "--fingerprint $key|"
			or die "Couldn't retreive key information from GPG: $!";
		while (<KEYINFO>) {
			chomp;
			@info = split(/:/);
			if ($info[0] eq 'pub') {
				$id = substr($info[4], -8);
				$expiry = $info[6];
			} elsif ($info[0] eq 'fpr') {
				$fpr = $info[9];
			} elsif ($info[0] eq 'uid') {
				push @uid, $info[1] . $info[9];
			} elsif ($info[0] eq 'uat') {
				push @uid, 'r' . $info[9];
			}
		}
		close KEYINFO;

		last if $id;
	}

	die "Key $key not found." unless $id;
	die "No non-revoked UIDs to sign." unless grep { /^[^r]/ } @uid;
	
	open GPG, "$gpg --export $id|" or die "Couldn't export from GPG: $!";
	@orig = <GPG>;
	close GPG;

	@fpr = ();
	for ($i = 4; $i <= 40; $i += 4) {
		push @fpr, substr($fpr, $i - 4, 4);
	}
	$fpr[4] .= " ";
	$fpr = join(" ", @fpr);

	print "$id  $fpr\n";
	foreach (@uid) {
		next unless /^(.)(.*)/;
		next if $1 eq 'r';
		$uidname = $2;
		
		print "          $uidname\n";
	}
	print "\n";
	print "Verified? (y123) ";
	$answer = <STDIN>;
	return if $answer !~ /^[yt123]/i;

	if ($answer =~ /[yt]/) {
		$level = 1;
	} else {
		$level = int($answer);
	}

	@sigs = ();

	for ($uid = 1; $uid <= @uid; $uid++) {
		next unless $uid[$uid-1] =~ /^(.)(.*)/;
		next if $1 eq 'r';
		$uidname = $2;

		open GPG, "|$gpg --default-cert-check-level $level " .
			  "--command-fd 0 --passphrase-fd 0 --edit $id"
			or die "Couldn't sign key $uid";
		print GPG $pass;
		print GPG "uid $uid\n";
		print GPG "sign\n";
		print GPG "y\n" if $expiry;
		print GPG "save\n";
		close GPG;

		open GPG, "$gpg --export $id|"
			or die "Couldn't export from GPG: $!";
		@new = <GPG>;
		push @sigs, @new;
		close GPG;

		$keyfile = "/tmp/signkey.$$.$id.$uid";

		open UID, ">$keyfile";
		if (@uid > 1) {
			print UID
"Below is the ASCII-armoured copy of your key, as received from
the keyservers, with *ONLY* the following UID signed by $name's key.

	$uidname

You will receive separate e-mails for each additional UID on your key.
Import each into your keyring as you receive them, then upload to the
keyservers once all have been added.";
		} else {
			print UID
"Below is the ASCII-armoured copy of your key, as received from
the keyservers and signed by $name's key.

Import this into your keyring then upload to the keyservers.";
		}

		print UID "\n\n(This e-mail was automatically generated.)\n\n";
		print UID @new;
		close UID;

		open GPG, "|$gpg --passphrase-fd 0 --encrypt --sign " .
			  "-r $id $keyfile"
			or die "Couldn't encrypt ${uid}: $!";
		print GPG $pass;
		close GPG;

		open ASC, "$keyfile.asc" or die "Missing asc file! $uid";
		@asc = <ASC>;
		close ASC;

		open MAIL, "|-", "/usr/sbin/sendmail", "-t", "-f", $mail
			or die "Couldn't write to sendmail: $!";
		print MAIL "From: $name <$mail>\n";
		print MAIL "To: $uidname\n";
		print MAIL "Subject: Signed GPG key: $id\n\n";
		print MAIL @asc;
		close MAIL;

		system(@gpg, "--delete-key", $id);
		open GPG, "|$gpg --import" or die "Couldn't reimport key $uid";
		print GPG @orig;
		close GPG;

		unlink $keyfile;
		unlink "$keyfile.asc";
	}

# Uncomment to have the signatures on your key when you finish
# 
#	open GPG, "|$gpg --import" or die "Couldn't import new sigs";
#	print GPG @sigs;
#	close GPG;
}