#!/usr/bin/perl

# Author: tomekk
# e-mail:  tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.2
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html
##########################################################

# added: ${original_recipient} as the rcpt. address (see 'man 8 pipe') - change because of aliases, see the example for ver 0.2

# some uses
use DBI;
use utf8;
use strict;
use File::Copy;
use File::Temp;
use Mail::Message;
use Encode qw(decode);
use Mail::Mailer qw(sendmail);

# config path
my $config = "/etc/ssqllda/ssqllda.conf";

##########################################################
# trim, lower input args
$ARGV[0] = trim(lc($ARGV[0])); # ${user}
$ARGV[1] = trim(lc($ARGV[1])); # ${domain}
$ARGV[2] = trim(lc($ARGV[2])); # ${sender}
$ARGV[3] = trim(lc($ARGV[3])); # ${original_recipient}

# farm of vars
my (@cfg_file, %conf);
my ($cfg_line, $conf_entry, $conf_entry_data);
my ($ts, $tn, $copy, $maildir, $new_maildir, $mail_file, $match);
my ($dbh, $select, $table, $result, $no_matches, $header_mark, $temp_header);
my ($mail, $mail_headers, $mail_obj, $mail_obj_subject);
my ($sub_to, $sub_from, $sub_subject, $sub_message);

# check number of input args
if (($#ARGV + 1) < 3)
{
	die "more arguments neeed, check your master.cf";
}

# read config file into array
open(CONFIG, $config) or die "cannot open $config";
@cfg_file = <CONFIG>;
close(CONFIG);

# parse config file
foreach $cfg_line (@cfg_file)
{
	$cfg_line =~ s/#.*//;
	$cfg_line = trim($cfg_line);
		
	($conf_entry, $conf_entry_data) = split(/\s*=\s*/, $cfg_line, 2);
	$conf{$conf_entry} = $conf_entry_data;
}

# get some data for the new file name
$ts = time;
$tn = mktemp('XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX');

# format mail dir path
$maildir = $conf{VUSER_MAILDIR};

# assign proper data to the string
$maildir =~ s/\$USER/$ARGV[0]/g;
$maildir =~ s/\$DOMAIN/$ARGV[1]/g;
$maildir =~ s/\$ORIGINAL/$ARGV[3]/g;

# make random file name
$mail_file = $ts . "." . $tn;

# read STDIN and write to tmp file and catch the header on-the-fly
$temp_header = "";
$header_mark = 1;
open (MAIL,">" . $maildir . "/tmp/" . $mail_file) or die "cannot open mail file - maybe wrong file path?, check your $config";
while (<STDIN>)
{
	# look for first 'empty' line
	if ($_ =~ m/^\s*$/)
	{
		$header_mark = 0;
	}
	
	# if still header part
	if ($header_mark)
	{
		$temp_header .= $_;
	}

	# anyway, put data into tmp file
	print MAIL $_;
}
close (MAIL);

# connect to DB
$dbh = DBI->connect("DBI:mysql:database=$conf{SQL_DB};host=$conf{SQL_HOST};port=$conf{SQL_PORT}", $conf{SQL_USER}, $conf{SQL_PASS}, {'PrintError' => 0}) or die "cannot select database: $DBI::errstr";

# prepare and execute SQL statements
# force 'names' charset
$dbh->do("SET NAMES UTF8");

# select records
$select = $dbh->prepare("SELECT type, header, pattern, action, action_opt, message, subject, maildir FROM `" . $ARGV[0] . "@" . $ARGV[1] . "` order by id ASC") or die "cannot prepare sql statement";
$table = $select->execute();

# check if table with filter rules for the given user@domain exists
if(!$table)
{
	# if not, move e-mail to default dir
	move ($maildir . "/tmp/" . $mail_file, $maildir . "/new/" . $mail_file) or die "tmp mail file cannot be moved";
} else { 
	# prepare mail header obj
	$mail_obj = Mail::Message->read($temp_header);                                                                                                                     
	$mail_obj_subject = lc(decode("MIME-Header", $mail_obj->head->get("Subject")));

	# no matches as default
	$no_matches = 1;

	# if exists, try to get all records
	while ($result = $select->fetchrow_hashref())
	{
		# defaults
		$match = 0;
	        $copy = 1;
		$new_maildir = $maildir;
	
		# trim and lower SQL data
		$result->{'type'} = trim(lc($result->{'type'}));
		$result->{'header'} = trim(lc($result->{'header'}));
		$result->{'pattern'} = trim(lc($result->{'pattern'}));
		$result->{'action'} = trim(lc($result->{'action'}));
		$result->{'action_opt'} = trim(lc($result->{'action_opt'}));
		$result->{'message'} = trim($result->{'message'});
		$result->{'subject'} = trim($result->{'subject'});
		$result->{'maildir'} = trim($result->{'maildir'});
		
		# check if mail matches filter rule
		if ($result->{'type'} eq "sender")
		{
			if ($ARGV[2] =~ m/$result->{'pattern'}/)
			{
				$match = 1;
			}
		} elsif ($result->{'type'} eq "subject") {
			
			if (utf8::is_utf8($mail_obj_subject))
			{
				utf8::encode($mail_obj_subject);
			}

			if ($mail_obj_subject =~ m/$result->{'pattern'}/)
			{
				$match = 1;
			} 
		} elsif ($result->{'type'} eq "header") {
			if (lc($mail_obj->head->get($result->{'header'})) =~ m/$result->{'pattern'}/)
			{
				$match = 1;
			}
		}

		# we have match
		if ($match)
		{
			# switch cause we have match for at least for one rule
	                $no_matches = 0;
	
			# move action
			if ($result->{'action'} eq "move")
			{	
				# if 'maildir' is not empty
				# if empty, default .conf dir will be used (for example if someone forget to set the 'maildir' dir)
				if ($result->{'maildir'})
				{
					$new_maildir = $result->{'maildir'};
				}
			}
	
			# respond action
			if ($result->{'action'} eq "respond")
			{
				# if pattern matches, send autorespond from the ${original_recipient} address
				send_msg ($ARGV[2], $ARGV[3], $result->{'message'}, $result->{'subject'});

				# check if we need to copy the e-mail or not
				if ($result->{'action_opt'} eq "save")
				{
					if ($result->{'maildir'})
					{
						$new_maildir = $result->{'maildir'};
					} else {
						$new_maildir .= "/new";
					}
				} elsif ($result->{'action_opt'} eq "nosave") {
					$copy = 0;
				} 
			}

			# copy or not copy, that's the question
			if ($copy)
			{
				copy ($maildir . "/tmp/" . $mail_file, $new_maildir . "/" . $mail_file) or die "tmp mail file cannot be copied";
			}
		}
	}

	# if table for the user@domain exists but is empty (or no matches), just move e-mail to default dir
	if ($no_matches)
	{
		move ($maildir . "/tmp/" . $mail_file, $maildir . "/new/" . $mail_file) or die "tmp mail file cannot be moved";
	}
}

# finish the SQL exe
$select->finish();

# end DB connection
$dbh->disconnect();

# we need to remove tmp file (for example when tmp file was copied not moved)
# don't need to check if file exists before unlink
unlink ($maildir . "/tmp/" . $mail_file);

# sent msg via sendmail
sub send_msg 
{
	($sub_to, $sub_from, $sub_message, $sub_subject) = @_;

	$mail = Mail::Mailer->new('sendmail');
	$mail_headers = { 'Content-Type' => 'text/plain; charset=UTF-8', To => $sub_to, From => $sub_from, Subject => $sub_subject };
	
	$mail->open($mail_headers);
	$mail->print($sub_message);
	$mail->close();
}

# c'mon PERL, trim!
sub trim($)
{
	my $trim = shift;
	$trim =~ s/^\s+//;
	$trim =~ s/\s+$//;
	return $trim;
}
