#!/usr/bin/perl -w
#
#   This code is based on smtpprox, by Bennett Todd, as found at
#                http://bent.latency.net/smtpprox/
#
#   It is distributed according to the terms of the GNU Public License as
#   found at <URL:http://www.fsf.org/copyleft/gpl.html>.
#
#   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.
#
# Written by Jonathan Hitchcock <vhata@rucus.ru.ac.za>
#
# Settings can be edited below.  The configuration file specified
# can be used instead of (or in addition to) passing options on the
# command line.  It simply consists of lines like:
#   children = 4
# where the keyword is the command-line option.
#
# When run, the script creates a .pid file in /var/run, which can
# be used by a shutdown script - the script will respond to a
# SIGTERM by killing all its children and shutting down.
#
# In other words, a startup/shutdown script could be as simple as
# the following, if a config file has been made:
#
#PROGNAME=proxfilter
#case "$1" in
#	start)
#		/var/spool/filter/$PROGNAME
#	;;
#	stop)
#		if [ ! -e /var/run/$PROGNAME.pid ] ; then
#			echo "$PROGNAME not running"
#		else
#			kill `cat /var/run/$PROGNAME.pid`
#		fi
#		echo
#	;;
#	restart)
#		$0 stop
#		$0 start
#	;;
#esac


use strict;
use Getopt::Long;
use IO::File;
use lib '.';
use POSIX;

use File::Basename qw/dirname/;

use lib dirname($0);
use MSDW::SMTP::Server;
use MSDW::SMTP::Client;


############################
# Settings
############################

my $children = 4;
my $minperchild = 100;
my $maxperchild = 200;
my $debugtrace = undef;
my $listen = undef;
my $talk = undef;
my $progname = "proxfilter";
my $debugdir = "/tmp";

my $configfile = "/etc/$progname.conf";

my $clamhost = "localhost";
my $clamport = 3310;

my $clamavheader = "X-Virus-Scanned: ClamAV Passed";
my $spamcheader = "X-Spam-Scanned: ";
my $scannedbyheader = "X-Scanned-By: $progname";

my $spamc = "/usr/bin/spamc -c";

############################
# Arguments
############################

my $syntax = "syntax: $0 [--children=$children] [--minperchild=$minperchild] ".
			 "[--maxperchild=$maxperchild] [--debugtrace=undef] ".
			 "--listen=listen.addr:port --talk=talk.addr:port\n";

if(-e $configfile) {
	open CFG, $configfile;
	while(<CFG>) {
		if(m/^\s*(\S+)\s*=\s*(\S+)\s*$/) {
			my ($key, $val) = (lc($1), $2);
			if($key eq "children") { $children = $val; }
			if($key eq "minperchild") { $minperchild = $val; }
			if($key eq "maxperchild") { $maxperchild = $val; }
			if($key eq "debugtrace") { $debugtrace = $val; }
			if($key eq "listen") { $listen = $val; }
			if($key eq "talk") { $talk = $val; }
		}
	}
}
GetOptions("children=n" => \$children,
		   "minperchild=n" => \$minperchild,
		   "maxperchild=n" => \$maxperchild,
		   "debugtrace=s" => \$debugtrace,
		   "listen=s" => \$listen,
		   "talk=s" => \$talk) or die $syntax;

die $syntax unless ($listen and $talk);
my ($srcaddr, $srcport) = split /:/, $listen;
my ($dstaddr, $dstport) = split /:/, $talk;
die $syntax unless defined($srcport) and defined($dstport);

############################
# Daemonize
############################

my $i=fork();
if(!defined $i) { die "Fork"; }
if($i>0) { exit(0); }
setsid();

############################
# Server
############################

my $server = MSDW::SMTP::Server->new(interface => $srcaddr, port => $srcport);

# This should allow a kill on the parent to also blow away the
# children, I hope
my %children;
my $isparent = 1;
use vars qw($please_die);
$please_die = 0;
$SIG{TERM} = sub { $please_die = 1; kill 15, keys %children if($isparent); };

open PID, "> /var/run/$progname.pid";
print PID $$;
close PID;

# close our streams
close STDIN;
close STDOUT;
close STDERR;
open STDIN, "/dev/null";
if(defined $debugtrace) {
	open STDOUT, ">$debugdir/$progname.parent.out.$$";
	open STDERR, ">$debugdir/$progname.parent.err.$$";
}
else {
	open STDOUT, ">/dev/null";
	open STDERR, ">/dev/null";
}

# This block is the parent daemon, never does an accept, just herds
# a pool of children who accept and service connections, and
# occasionally kill themselves off
PARENT: while (1) {
	while (scalar(keys %children) >= $children) {
		my $child = wait;
		delete $children{$child} if exists $children{$child};
		if ($please_die) { kill 15, keys %children; exit 0; }
	}
	my $pid = fork;
	die "$0: fork failed: $!\n" unless defined $pid;
	last PARENT if $pid == 0;
	$children{$pid} = 1;
	select(undef, undef, undef, 0.1);
	if ($please_die) { kill 15, keys %children; exit 0; }
}

$isparent = 0;

# If we daemonize, we must close our streams
close STDIN;
close STDOUT;
close STDERR;
open STDIN, "/dev/null";
if(defined $debugtrace) {
	open STDOUT, ">$debugdir/$progname.child.out.$$";
	open STDERR, ">$debugdir/$progname.child.err.$$";
}
else {
	open STDOUT, ">/dev/null";
	open STDERR, ">/dev/null";
}

# This block is a child service daemon. It inherited the bound
# socket created by SMTP::Server->new, it will service a random
# number of connection requests in [minperchild..maxperchild] then
# exit

my $lives = $minperchild + (rand($maxperchild - $minperchild));
my %opts;
if (defined $debugtrace) {
		$opts{debug} = IO::File->new(">$debugtrace.$$");
		$opts{debug}->autoflush(1);
}
else {
	$opts{debug} = IO::File->new(">/dev/null");
}

while (1) {
	$server->accept(%opts);
	my $client = MSDW::SMTP::Client->new(interface => $dstaddr, port => $dstport);
	my $banner = $client->hear;
	$banner = "220 $debugtrace.$$" if defined $debugtrace;
	$server->ok($banner);
	my $datawhat;
	while (my $what = $server->chat) {
		if($what =~ m/^data/i) {
			# Beginning of DATA segment.  "DATA" command is not passed on to client,
			# because content filters might reject it, in which case we don't want to
			# send it on to the client.  SMTP is such that if we QUIT before we DATA,
			# no mail will be sent. But once we DATA, there's no clean way to get
			# out of it.
			$server->{debug}->print("Received DATA command, beginning filtering.\n");
			# Store the DATA command to send later if the filters pass
			$datawhat = $what;
			# Ask the server to send us the data
			$server->ok("354 End data with <CR><LF>.<CR><LF>");
		}
		elsif ($what eq '.') {
			# Now we have received the entire data segment, we need to scan it.
			# scan() can get hold of the data from $server
			my $ref = scan($server, $client);
			# if scan() returned non-undef, the data passed:
			if($ref) {
				# send the original DATA command to the client
				$client->say($datawhat);
				# get its reply
				$client->hear();
				# and then yammer it.  An additional parameter is the array that
				# was returned by scan() - this contains headers to add in to the
				# data segment that can specify what the content filter found
				yammer($server, $client, @{$ref});
				$server->{debug}->print("PASSED\n");
				$server->ok($client->hear);
			}
			else {
				# content rejected
				$server->{debug}->print("FAILED\n");
				# tell the server that we like it, anyway.  We don't want viruses
				# and suchlike bouncing to the senders, since the sending address
				# was probably faked anyway.  We want to fail silently.
				$server->ok();
				# So far, the client has merely had "MAIL FROM:" and "RCPT TO:"
				# commands from us.  If we "QUIT" here, it won't think twice about
				# it, and nothing will be sent on.  Which is what we want.
				$client->say("QUIT");
			}
			# Delete the temporary file here.
			unlink($server->{datafilename});
		} else {
			# Normal conversation.
			$client->say($what);
			$server->ok($client->hear);
		}
	}
	$client = undef;
	delete $server->{"s"};
	exit 0 if $lives-- <= 0;
}

sub yammer {
	my ($server, $client, @addheaders) = (@_);
	my $fh = $server->{data};
	local (*_);
	local ($/) = "\r\n";
	# This is set until we find a blank line, which means the headers are about to end.
	my $inheaders = 1;
	while (<$fh>) {
		if(defined($inheaders) and m/^\r\n$/) {
			# End of headers
			undef $inheaders;
			# Quickly add in all our own headers
			foreach my $h (@addheaders) {
				$client->{sock}->print("$h\r\n");
			}
		}
		s/^\./../;
		$client->{sock}->print($_) or die "$0: write error: $!\n";
	}
	$client->{sock}->print(".\r\n") or die "$0: write error: $!\n";
}

############################
# Scanning
############################

sub scan {
	my ($server, $client) = (@_);
	my @addheaders;
	my $ret;
	
	# While we're scanning, we don't want the client to time-out. That would
	# suck, because then what do we do with this email?  The sender has already been
	# given the okay, so they think the mail has gone.
	# Send a NOOP every ten seconds, while we're scanning.
	local $SIG{ALRM} = sub { $client->say("NOOP"); $client->hear(); alarm 10; };
	# WARNING:
	# You can't combine 'alarm' with 'sleep', since some systems implement 'sleep'
	# using 'alarm', and you can only have one alarm at a time.  So, don't use
	# sleep during scan() or anything called by scan()
	alarm 10;
	
	# Basically, any scanner can be called here.  They can access the data by
	# using $server->{data} (a filehandle) or $server->{datafilename}
	# if they return undef, they failed
	# if they return anything else, it's taken to be a header to add to the
	# message when it gets passed on
	$ret = clamscan($server);
	if(!$ret) { return undef; }
	push @addheaders, $ret;
	
	$ret = spamscan($server);
	push @addheaders, $ret;
	
	$server->{data}->seek(0, 0);
	# Add our own little header
	push @addheaders, $scannedbyheader;
	
	# Disable the alarm now:
	alarm 0;
	return \@addheaders;
}

############################
# ClamAV
############################

use Net::Telnet ();
use Fcntl qw/F_SETFD F_GETFD/;

sub clamscan {
	my ($server) = (@_);
	
	# Connect to clamd and ask it to scan our file.
	# This is why we need to use "new IO::File" in MSDW::SMTP::Server,
	# instead of new_tmpfile
	my $t = new Net::Telnet(Host => $clamhost, Port => $clamport, Timeout => 300);
	my $fn = $server->{datafilename};
	$t->put("SCAN ".$fn."\n");
	my $clamoutput = $t->getline();
	chomp($clamoutput);
	$server->{debug}->print("CLAM: '$clamoutput'\n");
	$t->close();
	if($clamoutput =~ m/:\s+(.+)\s+FOUND$/) {
		return undef;
	}
	return $clamavheader;
}

############################
# Spamassassin
############################

use IPC::Open2;

sub spamscan {
	my ($server) = (@_);
	
	my ($outsa, $insa);
	no warnings;
	open F, $server->{datafilename};
	# connect to spamc and pipe the mail through it
	my $sapid = open2($outsa, "<&F", $spamc);

	waitpid $sapid, 0;
	my @spamcout = <$outsa>;
	foreach my $s (@spamcout) {
		$server->{debug}->print("SPAM: $s");
	}
	$spamcout[0] =~ m!^(.*)/(.*)$!;
	my $score = $1;
	
	return $spamcheader.$score;
}