package MIME::OpenSSL;
use warnings;
use strict;

use Carp;
use MIME::Parser;


our $VERSION="0.1";
our $Debug       =0; 
our $Test_On_Load=0; # will try to opne a test *.eml (S/MIME) on module load, for autochecking


=head1 NAME

MIME::OpenSSL - MIME OpenSSL Utility class

=head1 SYNOPSIS

	my $ssl=MIME::OpenSSL->new();

	my $ent=$ssl->SMIME_Open('/somepath/028923246130161DEVFP0.eml');
	print $ssl->error_str;
	my $atch=$ssl->SMIME_attachments;
	print "->".join(",",@$atch) if $atch;

=head1 DESCRIPTION

=head1 Constructors

=head2 new()

Creates a new MIME::OpenSSL object.  Can be called with a list of atribute value pairs,
where each attribute will be set.

This applies also to ANY other published method. Using a non-existant method will raise a
fatal run-time error.

=cut

my %Defaults=(
		temp_root   	=> "",                # Where to put temp files
		ssl_name    	=> "OpenSSL",         # name of OpenSSL executable
		ssl_bin_path    => "bin/",            # Path to the OpenSSL executable
		ssl_cert_path   => "certs/",          # Path to the cert bundle

		ssl_ca_file     => "ca-bundle.crt",   # root certs

		cert_file		=> $OpenSSL_CertFile, # for signing
		cert_pwd		=> $OpenSSL_PWD,

		sig_file    	=> "SMIME-signer.pk7",   
		x509_file   	=> "SMIME-signer.x509",
		payload_file	=> "SMIME-payload.smime",
		source_file		=> "Source_File.txt",
		signed_file		=> "SMIME-signed.smime",

		mail_spec   	=> "",
		mail_attribs	=> undef,

		sig_email   	=> "",
		error_str   	=> "",

		last_result 	=> "",
		history     	=> [],
		errors	    	=> [],
		auto_purge  	=> 1,
		mime_entity	    => undef,
		mime_parser     => undef,


	     );

{

	no strict 'refs';
	foreach my $key (sort keys %Defaults) {
		if (0) {
			print "\n=head2 $key()\n\n=cut\n";
		}
		*$key=sub {
				my $self=shift;

				return (ref($self))
				        ? ((!@_) ? $self->{$key}
				                 : ($self->{$key}=shift,$self))
				        : ((!@_) ? $Defaults{$key}
				        	 : ($Defaults{$key}=shift,$self))
			  };
	}

	local $Debug=0;
	__PACKAGE__->Version("0.9.6"); # replace with the apropriate version of OpenSSL
}

sub new {
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my %params=@_;
	my %self=%Defaults;
	my $self=bless \%self,$class;
	foreach my $key (keys %params) {
		$self->$key($params{$key});# if exists($self{$key});
	}
	return $self;
}

=head1 SSL Specific Properties

=head2 ssl_name()

Currently 'OpenSSL'

=head2 ssl_bin_path()

The path for the OpenSSL executable

=head2 ssl_cert_path()

The path for locating the ssl_ca_file

=head2 ssl_ca_file()

The name of Certificate Authority file to be used. Set the path through ssl_cert_path!

=head1 Intermediate Files and Paths

=head2 temp_root()

The root of the temp dir to be used for various OpenSSL intermediate files.

=head2 payload_file()

The filename the signed payload should be placed in.

=head2 sig_file()

The signature file to be used when parsing an EML file.

=head2 x509_file()

The filename for the x509 form of the signature, currently NOT used, may be removed.

=head1 Result Properties

=head2 mail_spec()

The last EML files parsed through SMIME_Open or Verify_EML

=head2 error_str()

Empty string or the last 'simple' error string returned from OpenSSL

=head2 last_result()

Last 'simple' result string from a call to Execute()

=head2 sig_email()

The mail spec contained in a Certificate. Currently only set after a call to
Verify_EML() was successfull

=head2 history()

Transaction of calls to OpenSSL and their entire results. Not produced when $Debug is
not set.

=head1 SMIME_Open Properties

=head2 mime_parser()

An SMIME_Open::mime_parser object. Produced by SMIME_Open() through SMIME_parser

=head2 mime_entity()

Root level MIME::mime_entity object from the last use of SMIME_Open(), or undef if there was none.

=head2 auto_purge()

When set to 1 a call to SMIME_Open will result in the last parsed mail being purged.
If its is set to 0 then the mail wil not be purged and -1 will result in a fatal error if
the last parse has NOT been purged first.

=cut

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



=head1 Methods

=head2 Version($min_version)

Returns or optionally checks the underlying OpenSSL version.

=cut

sub Version {
	my $self=shift;
	my $min=shift;

	my $version=$self->Execute("version");

	my $v_str=$1 if $version=~/\s((\d+\.)+\d)\s/;
	die "Expecting OpenSSL version $min but found $v_str"
		if $min && $v_str lt $min;
	return $v_str;
}


sub debug_print {
	my $self=shift;
	my $dirsymb=shift;

	my $str=scalar($self).$dirsymb.join("",@_);
	$str.="\n" unless ($str=~/\n$/);
	warn $str;
	chomp($str);
	return if !ref($self);
	push @{$self->{history}},$str;
}

sub debug_out {
	my $self=shift;
	return unless $Debug;

	$self->debug_print(" >>> ",@_);
}

sub debug_in {
	my $self=shift;
	return unless $Debug;

	$self->debug_print(" <<< ",@_);
}

=head2 Execute_Params(LIST)

Takes a list of individual commands and options to feed OpenSSL.  This list
is joined by a space and passed on to Execute().  Provided for cleaner interfacing.

=cut

sub pretty_params {
	my @params=@_;

	return "No Params" unless @params;
	my %ptree;
	my $p={};
	$ptree{shift @params}=$p;
	while (@params) {
		my $tag=shift @params;
		if ($params[0]=~/^-/o) {
			$p->{$tag}++;
		} else {
			$p->{$tag}=shift @params;
		}
	}
	return DumpHash(\%ptree);
}


sub Execute_Params {
	my $self=shift;

	warn pretty_params(@_)."\n" if $Debug<0;

	my $paramstr=join(" ",@_);
	return $self->Execute($paramstr);
}

=head2 Execute(STR)

Takes a string to pass to OpenSSL.
A log of the transaction is maintained in the C<history()> attribute when C<$Debug> is true.
Any 'simple' results from openssl, defined to be ones that do B<NOT> match
C</([[:xdigit:]]+):error:([[:xdigit:]]+):/>, will be returned.

=cut

sub parse_response {
	my $self =shift;
	my $errstr  =shift;

	my $err=MIME::OpenSSL::Error->new($errstr);
	push @{$self->errors},$err;
	return $err;
}

sub Execute {
	my $self  =shift;
	my $params=shift;

	my $cmd=$self->ssl_bin_path.$self->ssl_name." ".$params." 2>&1 |";
	$self->debug_out($cmd);
	$self->last_result("");
	$self->errors([]);
	if (open(EXE,$cmd)) {
		while (<EXE>) {

			$self->debug_in($_);
			if (/[[:xdigit:]]+:error:[[:xdigit:]]+:/) {
				#This should be called parse error
				$self->parse_response($_);
			} else {
				chomp;
				$self->last_result($_) if !$self->last_result($_);
			}
		}
	}
	if ($self->errors()->[0]) {
		$self->last_result($self->last_result." *** Error:".$self->errors()->[0]->string());
	}
	return $self->last_result;
}

=head1 SMIME_Open related methods


=head2 Verify_EML($eml_file_spec)

Uses OpenSSL to verify a mail. Returns B<false> if no errors occured, or a string
containing the B<simple> error message returned by OpenSSL.  The C<error_str()> property
will also contain the result.

If everything works out then the property C<payload_spec()> will contain the file
that was digitally signed, and the C<sig_email> property will contain the email address
of the owner of the certificate.

The array stored in history() contains a full log of the transaction that occured
with the OpenSSL executable.

B<Note> It is the callers responsibility to make sure that files are cleaned up and
that they dont conflict with or overwrite needed files

=cut


sub Verify_EML {
	my $self=shift;
	my $eml =shift;

	$self->mail_spec($eml);
	$self->history([]);
	$self->error_str("");

	my $res=$self->Execute_Params("smime",
				      "-signer",$self->sig_spec,
				      "-verify",
				      "-CAfile",$self->ca_spec,
				      "-in"    ,$self->mail_spec,
				      "-out"   ,$self->payload_spec);
	if ($res eq "Verification Successful") {
		$res=$self->Execute_Params("x509","-email",
					   "-in", $self->sig_spec,
					   "-out","NULL"); #$self->x509_spec);
	}
	if ($res=~/^[^@]+\@[^@]+$/) {
		$self->sig_email($res);
	} else {
		$self->error_str($res);
	}

	return $self->error_str();
}

=head2 SMIME_Open()

SMIME_Open is the preferred method for checking an SMIME file (EML file at this time).
Unlike Verify_EML (which it calls) SMIME_Open handles cleaning up files and directories
as well as actually parsing the mail, checking if the signatures email is the same as
the purported sender, not just validating its signature.

Returns a MIME::mime_entity object on success, undef on failure. (leaves mime_entity() set to the same
result.)

In the case of success it is up to the caller to use SMIME_purge prior to the next
parse.

See SMIME_purge(),SMIME_parser(),SMIME_attachments(),mime_entity(),mime_parser()

=cut

sub SMIME_Open {
	my $self=shift;
	my $file=shift;

	warn "SMIME_Open($file)\n" if $Debug;

	#First get a parser...
	my $mime_parser=$self->SMIME_parser;
	$self->mail_attribs(undef);
	#Grab the filename
	my $fn=($file=~/[\\\/]([^\\\/.]+)\..*$/)[0];



	#Check up on purgables..
	die "Auto Purge is < 0, and there are the following files left in cache.\n>\t".
	    join("\n>\t",@{$mime_parser->filer->purgable()})
	    	if ($self->auto_purge<0 && @{$mime_parser->filer->purgable()});

	#Setup the filer for this mail
	$mime_parser->output_under($self->temp_root,
	                           DirName=>"SMIME-$$-$fn");
	                           #Purge=>$self->auto_purge);
	$mime_parser->filer->output_prefix("SMIME-$fn");

	#And parse away
	my $mime_entity;
	eval ('$mime_entity=$mime_parser->parse_open($file);');
	if ($@) {
		my $errstr=$@;
		chomp $errstr;
		$errstr=~s/:/;/gms;
		$self->error_str($errstr);
		$self->last_result($errstr);
		#we fake an OpenSSL error... 02001002 is for a bad or missing file..
		$self->parse_response(".:.:02001002:.:.:$errstr:."); #dont ask....
		return undef;
	}

	#find out who its from...
	my $fr=$mime_entity->head->get('From');
	chomp($fr);
	#and other details
	{
		my $subj=$mime_entity->head->get('Subject');
		my $date=$mime_entity->head->get('Date');
		my $mlto=$mime_entity->head->get('To');
		chomp $subj;
		chomp $date;
		chomp $mlto;
		my %attribs=(subject=>$subj || "",
			     date   =>$date || "",
			     to     =>$mlto || "",
			     from   =>$fr   || "");
		$self->mail_attribs(\%attribs);
	}

	$self->mime_entity($mime_entity); 		       #store for later external use
	$self->temp_dir($mime_parser->filer->output_dir.'\\'); #use the filers temp directory

	$mime_entity->dump_skeleton if $Debug;
	#verfiy the mail
	unless  ($self->{no_verify}) {
		$self->Verify_EML($file);
	}

	# Get the MIME::Parser::FileUnder object to do our dirtywork
	$mime_parser->filer->purgeable($self->payload_spec);
	$mime_parser->filer->purgeable($self->sig_spec);
	$self->temp_dir(undef);

	return $mime_entity if $self->{no_verify};

	if ($self->Last_Secure) {
		if ($fr ne $self->sig_email) {
			my $e_str="Mail not from sender it says it is. ".
					 $fr." ne ".$self->sig_email;
			$self->error_str($e_str);
			$self->last_result($e_str);
			$self->parse_response(".:.:02001002:.:.:$e_str:."); #dont ask....
			#$self->mime_entity(undef);
			return undef;
		}
		return $mime_entity;
	} else {
		$self->SMIME_purge;
		$self->mime_entity(undef);
		return undef;
	}
}

=head2 SMIME_parser()

Create on demand property that maps to mime_parser()

=cut

sub SMIME_parser {
	my $self=shift;

	if (@_) {
		return $self->mime_parser(@_);
	} elsif (!$self->mime_parser()) {
		$self->mime_parser(MIME::Parser->new());
	}
	return $self->mime_parser;
}

=head2 SMIME_purge()

Removes any files or directories created by SMIME_Open()

=cut

sub SMIME_purge {
	my $self=shift;
	if ($self->mime_parser) {
		my $root=$self->mime_parser->filer->output_dir;
		$self->mime_parser->filer->purge();
		warn "Removing $root..." if $Debug;
		rmdir($root) if $root;
	}
}

=head2 Last_Secure()

Maps on to error_str(), but returns the inverse, and in numeric format (0 or 1).

C<< if ($ssl->error_str)... >> is logicially equivelent to C<< unless ($ssl->Last_Secure)... >>

=cut

sub Last_Secure {
	my $self=shift;

	return ($self->error_str) ? 0 : 1;
}



sub recurse_count_attach {
	my $e=shift;
	my $a=shift || [];
	my $d=shift || 0;
	my @prts=$e->parts;
	#print "Depth=>$d\n---------------------------\n";
	#$e->dump_skeleton;
	foreach my $p (@prts) {
		recurse_count_attach($p,$a,$d+1) if $p->parts;
		push @$a,$p->bodyhandle->path
			if ($p->head->recommended_filename
			   	&&
			   $p->head->recommended_filename!~/^smime/i);

	}
	return $a;
}

=head2 SMIME_attachments()

Returns a reference to a list of attachments contained in last correctly signed email (or mime_entity object
if provided) or an empty list if the mail was correctly signed but had
no attachments. Note that the term attachment applies only to files that have a recomended-filename
and where that filename does not match C<< $fn=~/^SMIME/i >> This is to avoid counting the signature
file as an attachment.

Returns undef if there was no mime_entity available, indicating the last mail (if there was one)
was bad.

=cut


sub SMIME_attachments {
	my $self=shift;
	my $ent=shift || $self->mime_entity || return undef;

	return recurse_count_attach($ent);
}

#openssl smime -sign -in $infile -out $outfile  -signer $OpenSSL_CERT

#sub SMIME_Write {
#	my $self=shift;
#	my $ent=shift || $self->mime_entity || return undef;
#
#	Execute_Params("-sign","-in",$infile,"-signer",$cert);
#
#}
#
#sub SMIME_Sign {
#	my $self   =shift;
#	my $infile =shift || $self->source_spec;
#	my $outfile=shift || $self->signed_spec;
#
#
#
#}


=head1 Derived Properties

=head2 temp_dir()

Allows temp_root to be overriden temporarily.

=head2 I<file>_spec()

=over 4

=item sig_spec()

=item payload_spec()

=item x509_spec()

=item CA_spec()

=back

Returns the approriately named file along with the appropriate path, mostly temp_dir.

=cut

sub temp_dir {
	my $self=shift;
	return (@_) ? ($self->{temp_dir}=shift,$self)
		    : ($self->{temp_dir}) ? $self->{temp_dir} : $self->temp_root;
}

sub sig_spec {
	my $self=shift;
	return $self->temp_dir.$self->sig_file;
}

sub payload_spec {
	my $self=shift;
	return $self->temp_dir.$self->payload_file;
}

sub x509_spec {
	my $self=shift;
	return $self->temp_dir.$self->x509_file;
}


sub ca_spec {
	my $self=shift;
	return $self->ssl_cert_path.$self->ssl_ca_file;
}

sub cert_spec {
	my $self=shift;
	return $self->ssl_cert_path.$self->ssl_cert_file;
}

sub signed_spec {
	my $self=shift;
	return $self->temp_dir.$self->signed_file;
}

sub source_spec {
	my $self=shift;
	return $self->temp_dir.$self->source_file;
}

DESTROY {
	my $self=shift;
	$self->SMIME_purge if $self->mime_parser;
}

if ($Test_On_Load) {
	require Data::Dumper;
	my $test=__PACKAGE__->new();
	$test->SMIME_Open(''); # some file
	#print $test->Version."\n";
	print Dumper($test)."\n";

}
1;

package MIME::OpenSSL::Error;

sub new {
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my ($code,$str);
	if (@_==1) {
		($code,$str)=(split(/:/,shift))[2,5];
	} elsif (@_==2) {
		($code,$str)=@_;
	} else {
		die "Wrong number of params..";
	}


	my $self={
			code   =>$code,
			string =>$str
		 };
	return bless $self,$class;
}

sub code {
	return shift->{code};
}

sub string {
	return shift->{string};
}

=head1 Author

Yves Orton / Demerphq

demerphq@hotmail.com

=head1 Copyright

This module is released under the Perl Artistic License.  However I would _really_ appreciate recieving copies of any
improvements/enhancements made to the software.

=Cut

1;