#!/usr/bin/perl -w

# Copyright (c) 2000, 2002 Christian Kurz <shorty@debian.org>,
# Copyright (c) 2000, 2002, 2005 Peter Palfrader <peter@palfrader.org>
#
# $Id$
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2, or (at your option)
#   any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software Foundation,
#   Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
#
# Keylookup is part of pgp-tools:
#           http://pgp-tools.alioth.debian.org/
#           svn://svn.debian.org/pgp-tools/trunk/
#           http://svn.debian.org/wsvn/pgp-tools/trunk/

delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
$|=1; # Always flush buffers


use strict;
use IO::Socket;
use IPC::Open3;
use Getopt::Long;

my $version = '3.0 ($Id$)';

# Strings to use in the dialog|whiptail frontend
my $TITLE = 'Import Keys';
my $BACKTITLE = 'KeyLookup $Revision$';
my $INSTRUCTION = 'Select keys to import:';
#
my @TPUTCOL=('tput', 'cols');
my @TPUTROW=('tput', 'lines');
my $DEFAULTCOLS = 80;
my $DEFAULTROWS = 25;
# Size of the dialog boxes, will be set in calcDialogSize;
my $MAX_UID_FIELD_LEN;
my @DIALOGSIZE;
my @WHIPTAILSIZE;


# Was the keyserver overriden|given on the command line?
# This is used to find out wheter we need to instruct the user
# to give the keyserver option to GnuPG.
my $keyserverWasSetOnCmdLine = 0;


# Maps algorithm numbers to algorithm types as defined in RFC 2400.
my %ALGOS = (
		 1 => 'R',         # RSA
		 2 => 'r',         # RSA encrypt only  (deprecated)
		 3 => 's',         # RSA sign only (deprecated)
		 16 => 'g',        # ElGamal encrypt only
		 20 => 'g',        # ElGamal sign and encrypt (all OpenPGP implementations cryptographically broken, do not use.  no longer part of OpenPGP)
		 17 => 'D'         # DSA
            );


# getHits receives all options as a parameter, calls fetchIT to
# query a keyserver, processes the output from the keyserver and
# stores it in a datastructure for later use.
sub getHits($) {
	my $options = shift;

	my $pid = open(KID, '-|');
	defined ($pid) or die ("Cannot fork: $!\n");
	unless ($pid) {
		close (STDIN);
		open (STDIN, "/dev/null") || die ("Cannot open /dev/null as stdin: $!\n");

		# child
		my @ops = ('gpg');
		if ($options->{'keyserver'}) {
			push @ops, '--keyserver='.$options->{'keyserver'};
		};
		push @ops, '--command-fd=0';
		push @ops, '--batch';
		push @ops, '--no-tty';
		push @ops, '--with-colons';
		push @ops, '--fixed-list-mode';
		push @ops, '--search';
		push @ops, @{$options->{'search'}};
		exec(@ops);
		die ("Cannot exec GnuPG: $!\n");
	};
	my %keys;
	my $currentKey;

	while (<KID>) {
		chomp;
		if ( $_ eq "" ) { next; }
		my ($type, undef) = split /:/;
		if ($type eq 'pub') {
			my ($type, $keyid, $algo, $bits, $created, undef, $revoked) = split /:/;
			$currentKey = { 'bits' => $bits,
					'type' => (defined $ALGOS{$algo} ? $ALGOS{$algo} : '#'.$algo),
					'keyid' => $keyid,
					'created' => $created,
					'revoked' => $revoked,
					'uid' => []
				      };
			$keys{ $keyid } = $currentKey;
		} elsif (defined $currentKey && $type eq 'uid') {
			my ($type, $name) = split /:/;
			if ($currentKey->{'revoked'} eq 'r') {
				$name .= ' [REVOKED]';
			};
			push @{ $currentKey->{'uid'} }, $name;
		};
	};
	close KID;
	waitpid $pid, 0;

	return \%keys;
};

# returns the number of columns of the terminal
sub getCols {
	my $pid;
	return $DEFAULTCOLS unless (defined ($pid = open(KID, "-|")));
	unless ($pid) {
		exec (@TPUTCOL);
	};
	my $cols = <KID>;
	close KID;
	wait;
	return (defined $cols) ? $cols : $DEFAULTCOLS;
};

# returns the number of lines of the terminal
sub getRows {
	my $pid;
	return $DEFAULTROWS unless (defined ($pid = open(KID, "-|")));
	unless ($pid) {
		exec (@TPUTROW);
	};
	my $rows = <KID>;
	close KID;
	wait;
	return (defined $rows) ? $rows : $DEFAULTROWS;
};

# sets MAX_UID_FIELD_LEN, DIALOGSIZE, and WHIPTAILSIZE
sub calcDialogSize {
	my $COLS = &getCols();
	my $ROWS = &getRows();
	$MAX_UID_FIELD_LEN = $COLS - 27;
	@DIALOGSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
	@WHIPTAILSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
}

sub prepareForDialog {
	my $keys = shift;
	my @keyargs = ();

	for my $keyid (sort {- ($keys->{$a}->{'created'} <=> $keys->{$b}->{'created'})} keys %$keys) {
		for (@{ $keys->{$keyid}->{'uid'} }) {
			push @keyargs,
				$keys->{$keyid}->{'keyid'},
				length() <= $MAX_UID_FIELD_LEN ? $_ : substr($_, 0, $MAX_UID_FIELD_LEN-2) . '..',
				'off';
		};
		my (undef,undef,undef,$mday,$mon,$year,undef,undef,undef) = localtime ($keys->{$keyid}->{'created'});
		push @keyargs, $keys->{$keyid}->{'keyid'}, sprintf( "[created: %s-%s-%s]", $year+1900, $mon+1, $mday ), 'off';
		push @keyargs, '-'x8, '-'x40, 'off';
	};
	pop @keyargs;
	pop @keyargs;
	pop @keyargs;

	return \@keyargs;
};

sub prepareForTXT {
	my $keys = shift;
	my @lines = ();

	for my $keyid (sort {- ($keys->{$a}->{'created'} <=> $keys->{$b}->{'created'})} keys %$keys) {
		my (undef,undef,undef,$mday,$mon,$year,undef,undef,undef) = localtime ($keys->{$keyid}->{'created'});
		push @lines, sprintf( "%s%s/%s %s-%s-%s\n",
		                      $keys->{$keyid}->{'bits'},
		                      $keys->{$keyid}->{'type'},
		                      $keys->{$keyid}->{'keyid'},
		                      $year+1900, $mon+1, $mday );
		push @lines, map { ' 'x26 . $_ . "\n" } @{ $keys->{$keyid}->{'uid'} };
		push @lines, "\n";
	};

	return \@lines;
};

sub callDialog {
	my $args = shift;

	# open(SAVEOUT, ">&STDOUT") || die ("Cannot save STDOUT: $!\n");
	# open(SAVEIN , "<&STDIN" ) || die ("Cannot save STDIN: $!\n");

	my $pid = open3( '<&STDIN', '>&STDOUT', \*ERRFH, @$args);
	
	my %unique;
	my @keys = grep { !$unique{$_}++ }
		# get the keyID; can be 8, 16 or 40 nibbles
		grep { /^((([a-zA-Z0-9]{24})?[a-zA-Z0-9]{8})?[a-zA-Z0-9]{8})$/ }
		map { s/\s//g; $_ } <ERRFH>;
	wait;

	# open(STDOUT, ">&SAVEOUT") || die "Cannot restore STDOUT: $!\n";
	# open(STDIN , "<&SAVEIN")  || die "Cannot restore STDIN: $!\n";

	return \@keys;
};

sub selectKeys {
	my $keys = shift;
	my $options = shift;

	my $frontend = $options->{'frontend'};
	$frontend = 'dialog' unless (defined $frontend);

	if ($frontend eq 'dialog') {
		unless (`which dialog` && $? == 0) {
			warn("Dialog not executeable/installed. Falling back to Whiptail\n");
			$frontend = 'whiptail';
		}
	};
	if ($frontend eq 'whiptail') {
		unless (`which whiptail` && $? == 0 ) {
			warn("Whiptail not executeable/installed. Falling back to plain\n");
			$frontend = 'plain';
		}
	};

	if ( $frontend eq 'dialog' ) {
		calcDialogSize;
		my @ARGS = (
			'dialog',
			'--backtitle',
			$BACKTITLE,
			'--separate-output',
			'--title',
			$TITLE,
			'--checklist',
			$INSTRUCTION,
			@DIALOGSIZE);
		push @ARGS, @{&prepareForDialog($keys)};
		return &callDialog( \@ARGS );
	} elsif ( $frontend eq 'whiptail' ) {
		calcDialogSize;
		my @ARGS = (
			'whiptail',
			'--backtitle',
			$BACKTITLE,
			'--separate-output',
			'--title',
			$TITLE,
			'--checklist',
			$INSTRUCTION,
			@WHIPTAILSIZE,
			'--');
		push @ARGS, @{&prepareForDialog($keys)};
		return &callDialog( \@ARGS );
	} else {
		print for (@{ &prepareForTXT( $keys ) });
		if ($keyserverWasSetOnCmdLine) {
			printf ("Now run gpg --keyserver %s --recv-keys <key ids>\n", $options->{'keyserver'});
		} else {
			print ("Now run gpg --recv-keys <key ids>\n");
		};

		## If no frontend was selected, or selected frontend was plain,
		## exit successfully, otherwise with an exitcode != 0
		exit (defined $options->{'frontend'} &&
		      $options->{'frontend'} ne "" &&
		      $options->{'frontend'} ne "plain");
	};
};

sub importKeys {
	my $keyids = shift;
	my $options = shift;

	my @args = ('gpg');
	if ($options->{'keyserver'}) {
		push @args, '--keyserver='.$options->{'keyserver'};
	};
	push @args,  '--recv-keys';
	for my $keyid (@$keyids) {
		# untaint keyids
		my ($cleanid) = $keyid =~ /^((([a-zA-Z0-9]{24})?[a-zA-Z0-9]{8})?[a-zA-Z0-9]{8})$/;
		warn ("keyid '$keyid' has unexpected format - skipping\n"), next
			unless defined $cleanid;
		push @args, $cleanid;
	}

	print "Calling GnuPG...\n";
	exec (@args) || die "can't exec gnupg: $!\n"; # won't return
};


sub usage {
	my $errorcode = shift;
	print << 'EOF'
Syntax: keylookup [options] <searchstring>

Options:
	--keyserver=<keyserver>	Select keyserver
	--frontend=<frontend>	One of whiptail, dialog or plain
	--importall		Import all matched keys
	--help			print this message

EOF
;
	exit($errorcode);
};

sub version {
	print "keylookup $version\nWritten by Christian Kurz and Peter Palfrader.\n";
	exit(0);
};

	my %options;
	GetOptions( \%options,
		'keyserver=s',
		'frontend=s',
		'importall',
		'version',
		'help') or
		&usage(1);
	&version(0) if ($options{'version'});
	&usage(0) if ($options{'help'} || ( scalar(@ARGV) == 0));

	## Take all additional arguments to the program as a search target,
	## escape the string for use in URLs.
	$options{'search'} = \@ARGV;
	my $keys = getHits( \%options );
	my $keyids;

	if (scalar keys %$keys == 0) {
		print "GnuPG did not find any keys matching your search string.\n";
		exit 0;
	};
	if ($options{'importall'}) {
		my @allkeys = keys %$keys;
		$keyids = \@allkeys;
	} else {
		$keyids = selectKeys($keys, \%options); # won't return if no interactive frontend
	};
	&importKeys($keyids, \%options) if (scalar @$keyids);	# won't return