##############################################################################
#
#	Pronto::Crypt::GPG -	This module provides the interfacing
#		required to get Pronto to interface to GPG.  This module
#		is defined to be as generic as possible and I encourage
#		any use for any other project to feed back any bug fixes
#		or modifications back to us so we can all benefit.
#
#	Author		-	Redvers Davies <red@madhouse.org.uk>,
#			-	Maher Awamy <muhri@muhri.net>
#	
#	Copyright 2000 Critical Integration Ltd
#	Licenced under the GNU Public Licence (GPL).
#
#	$Id: GPG.pm,v 1.6 2002/05/19 06:20:47 muhri Exp $
#
##############################################################################

package Pronto::Crypt::GPG;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use IPC::Open3;

require Exporter;

#@ISA = qw(Pronto::Crypt Exporter AutoLoader);
@ISA = qw(Pronto::Crypt);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '0.01';

sub new {
	my $class = shift;
	my $self = {};
	my $hashref = shift;

	foreach my $key (keys %$hashref) {
		$self->{$key} = $hashref->{$key};
	}

	bless($self, $class);
	return($self);
}

## Method to see if keyid specified is in the local keyring

sub is_key_local {
	my $self = shift;
	my $pattern = shift;

	$self->wr_debug("KeyID to check is $pattern");
	$self->wr_debug("Using GPG binary at: ".$self->{gpgpath});

	$self->wr_debug("$self->{gpgpath} --fingerprint --with-colons $pattern 2> /dev/null");
	my @gpg_raw = `$self->{gpgpath} --fingerprint --with-colons $pattern 2> /dev/null`;
	chomp(@gpg_raw);

	## Return hash in following manner:
	## $rethash->{keyid}{bits,created,string,fingerprint...}

	my $counter = 0;
	my $keyid;		## Has to be sticky
	my $returnhash = {};	## Define it properly

	while ($counter < $#gpg_raw) {
		$self->wr_debug("Line: $gpg_raw[$counter]");
		if ($gpg_raw[$counter] =~ /^pub/) {
			my @public_array = split(/:/, $gpg_raw[$counter]);
			my $longid = $public_array[4];
			$self->wr_debug("Long ID: $longid");
			$longid =~ /(........)$/;
			$keyid = $1;

			$returnhash->{"0x$keyid"}{trust} = $public_array[1];
			$returnhash->{"0x$keyid"}{length} = $public_array[2];
			$returnhash->{"0x$keyid"}{algorithm} = $public_array[3];
			$returnhash->{"0x$keyid"}{fullkeyid} = $public_array[4];
			$returnhash->{"0x$keyid"}{created} = $public_array[5];
			$returnhash->{"0x$keyid"}{expires} = $public_array[6];
			$returnhash->{"0x$keyid"}{localid} = $public_array[7];
			$returnhash->{"0x$keyid"}{ownertrust} = $public_array[8];
			$returnhash->{"0x$keyid"}{string} = $public_array[9];

			$self->wr_debug("Keyid: 0x$keyid");
			$self->wr_debug("Length: $returnhash->{\"0x$keyid\"}{length}");
			$self->wr_debug("Algorithm: $returnhash->{\"0x$keyid\"}{algorithm}");
			$self->wr_debug("FullkeyID: $returnhash->{\"0x$keyid\"}{fullkeyid}");
			$self->wr_debug("Created: $returnhash->{\"0x$keyid\"}{created}");
			$self->wr_debug("Expires: $returnhash->{\"0x$keyid\"}{expires}");
			$self->wr_debug("LocalID: $returnhash->{\"0x$keyid\"}{localid}");
			$self->wr_debug("Ownertrust: $returnhash->{\"0x$keyid\"}{ownertrust}");
			$self->wr_debug("String: $returnhash->{\"0x$keyid\"}{string}");

			$counter++;
			next;
		}

		if ($gpg_raw[$counter] =~ /^fpr/) {
			my @fingerprint_array = split(/:/, $gpg_raw[$counter]);
			$self->wr_debug("0x$keyid => $fingerprint_array[9]");
			$returnhash->{"0x$keyid"}{fingerprint} = $fingerprint_array[9];
			$counter++;
			next;
		}

	$counter++;
		
	}

	return(1, $returnhash);

}

sub encrypt {
	my $self = shift;
	my $keyarray = shift;
	my $textarray = shift;
	my $encrypt = shift;
	my $sign = shift;
	my $ownkey = shift;
	my $passphrase;
	
	if ($sign) {
	
		if (defined $self->{passphrase}) {
		       $passphrase = $self->{passphrase};
	       	} else {
		       $self->obtain_passphrase();
		       $passphrase = $self->{'passphrase'};
		}	
	}
	
	my @flags;
	my $pid;

	foreach my $user (@$keyarray) {
		push(@flags, "-r \"$user\" ");
	}

	if (($encrypt) && ($sign)) {
		$pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, "$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty -sea -u \"$ownkey\" @flags");
#		$self->wr_debug("$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty -sea -u $ownkey @flags");
	} elsif (($encrypt) && (!($sign))) {
		$pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, "$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty -ea @flags");
#		$self->wr_debug("$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty -ea @flags");
	} elsif ((!($encrypt)) && ($sign)) {
		$pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, "$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty --clearsign -u \"$ownkey\"");
#		$self->wr_debug("$self->{gpgpath} --status-fd 2 --batch --passphrase-fd 0 --no-tty --clearsign -u \"$ownkey\" @flags");
	} else {
		$self->wr_debug("Why were we called in the first place?");
		return 1;
	}
		


	if ($sign) {
		print(WTRFH "$passphrase\n");
	}

	foreach my $line_in (@$textarray) {
		print(WTRFH "$line_in");
	}

	close(WTRFH);

	my @stdout = <RDRFH>;
#	$self->wr_debug("STDOUT: @stdout");
	close(RDRFH);
	
	my @sterr = <ERRFH>;
#	@sterr = grep(/\[GNUPG:\]/, @sterr);
#	$self->wr_debug("STDERR: @sterr");
	close(ERRFH);

	if ($main::prefs{'forget_passphrase'}) {
	   $self->{'passphrase'} = undef;
	}   

	if (!$stdout[0] || $stdout[0] !~ /--BEGIN/) {
		return([], \@sterr);
	}

	return(\@stdout, \@sterr);

}

sub decrypt {
	my $self = shift;
	my $messageref = shift;
	my $passphrase = $self->{'passphrase'};

	if (!$passphrase) {
		$self->obtain_passphrase();
		$passphrase = $self->{'passphrase'};
	}	

#	$self->wr_debug("decrypt\($messageref, passphrase\) has been called");

	my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, "$self->{gpgpath} --decrypt --status-fd 2 --batch --passphrase-fd 0 --no-tty");

	print(WTRFH "$passphrase\n");
	print WTRFH $messageref;
	
	close WTRFH;
	
	my @stdout = <RDRFH>;
	close RDRFH;
	
	my @sterr = <ERRFH>;
	close ERRFH;

	if (grep(/BAD_PASSPHRASE/, @sterr)) {
		$self->{'passphrase'} = undef;
		$stdout[0] = _("Please Try again\n");
	}

	if ($main::prefs{'forget_passphrase'}) {
	   $self->{'passphrase'} = undef;
	}   

	if (!$stdout[0] || $stdout[0] eq " ") {
		return ([], \@sterr);
	}	

       
	return(\@stdout, \@sterr);

}

sub verify 
{
	my $self = shift;
	my $messageref = shift;

#	$self->wr_debug("decrypt\($messageref, passphrase\) has been called");

	my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, "$self->{gpgpath} --verify --status-fd 2 --batch --no-tty");

	print WTRFH $messageref;
	
	close WTRFH;
	
	my @stdout = <RDRFH>;
	close RDRFH;
	
	my @sterr = <ERRFH>;
	close ERRFH;
	
	if (!$stdout[0] || $stdout[0] eq " ") {
		return([], \@sterr);
	}	
	
	return(\@stdout, \@sterr);

}


sub search_server {
	my $self = shift;
	my $server = shift;
	my $string = shift;

	$self->wr_debug("search_server\($server, $string\)");
	my $teststring = "http://wwwkeys.pgp.net:11371/pks/lookup?op=vindex&search=redvers&fingerprint=on";
	
	my $serverobj = new IO::Socket::INET(PeerAddr => "$server", PeerPort => "11371", Proto => "tcp");
	print($serverobj "GET http://wwwkeys.pgp.net:11371/pks/lookup?op=vindex&search=redvers&fingerprint=on");
	print($serverobj "\n\n");

	my @raw_server = <$serverobj>;

	close($serverobj);

	$self->wr_debug("@raw_server");





}


sub set_path {
	my $self = shift;
	my $path = shift;

	$self->{gpgpath} = $path;

	return 1;

}






















#objectref->import_key_from_server
#objectref->send_key_to_server
#objectref->localsign
#objectref->realsign

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

Pronto::Crypt::GPG - Perl extension for blah blah blah

=head1 SYNOPSIS

  use Pronto::Crypt::GPG;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for Pronto::Crypt::GPG was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 AUTHOR

A. U. Thor, a.u.thor@a.galaxy.far.far.away

=head1 SEE ALSO

perl(1).

=cut


## Method new: Used to initialise the GPG support.