#!/usr/bin/perl -w
# ****************************************************************************
# MTA/Mail-Hub, a wrapper for ESMTP enabled relays that need plain text auth
# Copyright (C) 2003  Uwe Disch
# 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 of the License, 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., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307, USA. 
# ****************************************************************************
# MTA/Mail-Hub 0.1.5
#	  - this script acts as wrapper around an ESMTP enabled relay that need
#		plain text authentication, MTA/Mail-Hub is intended to be used from
#		ESMTP/SMTP servers that can't do plain text authentication
#		parameters: -/-
#	  - I have written MTA/Mail-Hub in less then two days, because of this it
#		is in some way a quick and dirty hack. Furthermore it is my first perl
#		script with more than 20 lines of code. I hope it has no real bug's,
#		if you find one, feel free to correct it and send me a copy of your
#		changes. I'm glad to learn. My e-mail is:
#		uwe (dot) disch (at) disch-online (dot) de
#	  - new versions of MTA/Mail-Hub can be found at:
#		http://disch-online.de/mail-hub.php
#
# How to use it:
#	  - copy mail-hub.pl to /usr/sbin/
#	  - change access rights with chmod 500 /usr/sbin/mail-hub.pl
#	  - change owner with chown root.root /usr/sbin/mail-hub.pl
#	  - this script is run for example from inetd, please add to
#		/etc/inetd.conf this line:
#		smtp stream tcp nowait root /usr/sbin/mail-hub.pl
#	  - reload inetd with /sbin/init.d/inetd reload
#	  - this script is tested with SuSE Linux 6.4 and Perl 5.005_03 on host
#		system
#	  - testet clients are: Microsoft Exchange Server 5.5, Outlook Express 5.5
#		and, of course, manual mail sending with netcat
#	  - tested mail relay is: relay.t-dsl-business.de, it's the same relay as
#		relay.t-online-com.de, so it should work for a wide range of German
#		users
#
# Version history:
#	  - is found on end of script
# ****************************************************************************
use Socket;
use MIME::Base64;
use Sys::Hostname;

# predefined data for outgoing connection, please modify to fit your current
# setup
my($mailServer) = 'relay.t-dsl-business.de';
my($username)   = 'someuser@somedomain.com';
my($password)   = 'somepassword';
# define lines of disclaimer (lofdiscl) and disclaimer (discl) itself, added
# by Uwe Disch 2003-04-02
# next lines are giving you 74 of '-' as little helper for your disclaimer:
#                            1    1    2    2    3    3    4    4    5    5    6    6    7   
#                  0----5----0----5----0----5----0----5----0----5----0----5----0----5----0---
#                  --------------------------------------------------------------------------\r\n
$discl[0]       = "__________________________________________________________________________\r\n";
$discl[1]       = "\r\n";
$discl[2]       = "This e-mail is solely intended to be used only by the legal recipient.\r\n";
$discl[3]       = "If you are not the legal recipient of this e-mail then you must delete\r\n";
$discl[4]       = "this e-mail and inform the sender about this issue.\r\n";
$discl[5]       = "If not otherwise stated: copyright (c) 2003 Uwe Disch.\r\n";
$discl[6]       = "E-mail sent trough: MTA-Mail-Hub 0.1.5 http://disch-online.de/mail-hub.php\r\n";
#                  --------------------------------------------------------------------------\r\n
#                  0----5----0----5----0----5----0----5----0----5----0----5----0----5----0---
#                            1    1    2    2    3    3    4    4    5    5    6    6    7   
my($lofdiscl)   = 7;
# end changes by Uwe Disch 2003-04-02

# predefined data for logging
$logfile        = "/var/log/log.mail-hub"; # path to logfile
my($isdebug)    = 0; # set to 1 to have debug logging enabled
my($islogging)  = 1; # general logging

# predefined data for the initial lines of the relay, in general there is
# coming one initial line, some servers are sending two lines, then change it
my($nooflines)  = 1;

# predefined data, please do not change
my($mailer)     = "ESMTP [Mail-Hub 0.1.5 by Disch Engineering]";
my($host)       = hostname();
my($greeting)   = "220 $host $mailer started at";
my($quitmsg)    = "221 $host exiting";
my($auth)       = encode_base64("\000" . $username . "\000" . $password);

# general stuff
$main::SIG{'INT'} = 'closeSocket';

my($proto)      = getprotobyname("tcp") || 6;
my($port)       = getservbyname("SMTP", "tcp") || 25;
my($serverAddr) = (gethostbyname($mailServer))[4];

die('gethostbyname failed.') unless (defined($serverAddr));

logLTIME("$mailer", "started");

# create socket, connect to relay and retrieve first line(s)
socket(SMTP, AF_INET(), SOCK_STREAM(), $proto)
	or die("socket: $!");
$packFormat = 'S n a4 x8';
connect(SMTP, pack($packFormat, AF_INET(), $port, $serverAddr))
	or die("connect: $!");

select(SMTP); $| = 1; select(STDOUT); # use unbuffered i/o
# switch to unbuffered i/o because of these curly brackets
{
	my($inpBuf) = '';
	for ($i = 0; $i < $nooflines; $i++) {
		recv(SMTP, $inpBuf, 200, 0);
	}
}

# say hello and authenticate to relay
my($firstresp) = sendSMTP($isdebug, 1, "EHLO $host\r\n");
# if relay not ready, then quit
my($response) = (split(/-/, $firstresp))[0];
if ($response ne "250") {
	close(SMTP);
	logLTIME("$mailer", "interrupted");
	exit(1);
}
$response = sendSMTP($isdebug, 0, "AUTH PLAIN\r\n");
# if no authentication available at all, then quit
if ($response ne "334") {
	close(SMTP);
	logLTIME("$mailer", "interrupted");
	exit(1);
}
$response = sendSMTP($isdebug, 0, "$auth");
# if no access granted, then quit
if ($response ne "235") {
	close(SMTP);
	logLTIME("$mailer", "interrupted");
	exit(1);
}

# now, answer incoming connection, outgoing connection stays open, greeting
# has to be changed to that from relay
my $localtime = scalar localtime;
print STDERR ("$greeting $localtime\r\n");
doLOG($isdebug, "$greeting $localtime\n");
my($isgood) = 0;
while ($isgood == 0) {
	$response = recvSMTP($isdebug, 1, "$firstresp");
	print STDERR ("$response");
	$response = (split(/ /, $response))[0]; # first line of SMTP response
	if ($response eq "250") {
		$isgood = 1;
	}
	else {
		$response = (split(/-/, $response))[0]; # first line of ESMTP response
		if ($response eq "250") {
			$isgood = 1;
		}
	}
}

# forward all input directly to the relay and print all output immediate
# until we see a QUIT, no checking needed, checking is done by relay itself
my($isquit) = 0;
while($isquit == 0) {
	$response = forwardSMTP($isdebug, 1);
	print STDERR ("$response");
	$isquit = isQUIT(0, 0, "$response");
}

close(SMTP);
logLTIME("$mailer", "finished");

# ****************************************************************************
# sub closeSocket - close SMTP socket on SIGINT
#					parameters: -/-
# ****************************************************************************
sub closeSocket {     # close smtp socket on error
	doLOG($isdebug, "! start closeSocket\n");
	close(SMTP);
	logLTIME("$mailer", "interrupted");
	die("SMTP socket closed due to SIGINT\n");
}

# ****************************************************************************
# sub sendSMTP - send given string from buffer to relay and return response
#				 from relay
#					parameters:
#					- debug, if 1 then print buffer to LOG
#					- nosplit, if 0 then return buffer up to first blank
#					- buffer, is input and response string
# ****************************************************************************
sub sendSMTP {
	my($debug)   = shift;
	my($nosplit) = shift;
	my($buffer)  = @_;
	doLOG($debug, "! start sendSMTP\n");

	doLOG($debug, "> $buffer");
	send(SMTP, $buffer, 0);

	recv(SMTP, $buffer, 200, 0);
	doLOG($debug, "< $buffer");

	if ($nosplit) {
		;
	}
	else {
		$buffer = (split(/ /, $buffer))[0];
	}
	return($buffer);
}

# ****************************************************************************
# sub forwardSMTP - get one line from STDIN and return response from relay, if
#					we find data then we start a loop until we find CRLF.CRLF
#					parameters:
#					- debug, if 1 then print buffer to LOG
#					- nosplit, if 0 then return buffer up to first blank
# ****************************************************************************
sub forwardSMTP {
	my($debug)   = shift;
	my($nosplit) = @_;
	doLOG($debug, "! start forwardSMTP\n");

	# send request
	$inbuf  = <STDIN>;
	doLOG($debug, "! forwardSMTP after STDIN\n");
	my($buffer) = $inbuf;
	doLOG($debug, "> $buffer");
	send(SMTP, $buffer, 0);

	# receive response
	recv(SMTP, $buffer, 200, 0);
	doLOG($debug, "< $buffer");

	# special handling for data response
	my($tempbuf) = (split(/ /, $buffer))[0];
	if ($tempbuf eq "354") {
		# 354 response has to be sended separately
		print STDERR ("$buffer");
		my($iseod) = 0;
		while ($iseod == 0) {
			$inbuf  = <STDIN>;
			$buffer = $inbuf;
			# changes, because of sending disclaimer by Uwe Disch 2003-04-02
			# special handling for end of data
			$tempbuf = "$buffer";
			if (($tempbuf eq ".\n") or ($tempbuf eq ".\r\n")) {
				# send disclaimer
				for($i = 0; $i < $lofdiscl; $i++) {
					send(SMTP, $discl[$i], 0);
				}
				$iseod = 1;
				doLOG($debug, "! forwardSMTP eod recognized\n");
			}
			# every trip:	buffer contains inbuf
			# last trip:	buffer contains the ".\r\n" (or ".\n") out of inbuf
			#				and there was send the disclaimer before
			send(SMTP, $buffer, 0);
			doLOG($debug, "> $buffer\n");
			# end changes, by Uwe Disch 2003-04-02
		}
		# receive end of data response
		recv(SMTP, $buffer, 200, 0);
		doLOG($debug, "< $buffer");
	}

	if ($nosplit) {
		;
	}
	else {
		$buffer = (split(/ /, $buffer))[0];
	}
	return($buffer);
}

# ****************************************************************************
# sub recvSMTP - get one line from STDIN and return special first response
#				 provided by buffer, no handling with relay
#					parameters:
#					- debug, if 1 then print buffer to LOG
#					- nosplit, if 0 then return buffer up to first blank
#					- buffer, is parsed for HELO or helo
# ****************************************************************************
sub recvSMTP {
	my($debug)   = shift;
	my($nosplit) = shift;
	my($buffer)  = @_;
	doLOG($debug, "! start recvSMTP\n");

	$inbuf = <STDIN>;
	doLOG($debug, "$inbuf");
	# first we have to check inbuf for existance of ehlo/helo, client name is
	# ignored
	my($incmd)  = ( (split(/ /, $inbuf))[0] );
	# remove LF
	chomp($incmd);
	# make all uppercase
	$incmd = uc $incmd;

	if (($incmd eq 'HELO') or ($incmd eq 'HELO\r')) {
		# stored initial response from relay, return only first line
		my($firstline) = ((split(/^/, $buffer))[0]);
		my(@tempbuf) = (split(/-/, $firstline));
		$firstline = join ' ', (@tempbuf)[0], (@tempbuf)[1];
		$firstline = join '-', $firstline, (@tempbuf)[2], (@tempbuf)[3];
		$buffer = $firstline;
	}
	elsif (($incmd eq 'EHLO') or ($incmd eq 'EHLO\r')) {
		# if ELHO/ehlo is coming then show all existing lines that are
		# starting with 250, i.e. do nothing here
		;
	}
	elsif (($incmd eq 'QUIT') or ($incmd eq 'QUIT\r')) {
		# do final response and quit
		print STDERR ("$quitmsg\r\n");
		close(SMTP);
		logLTIME("$mailer", "finished");
		exit(1);
	}
	else { # minimal error handling
		$buffer = "500 Command unrecognized: \"$incmd\"\r\n";
	}
	doLOG($debug, "< $buffer");

	if ($nosplit) {
		;
	}
	else {
		$buffer = (split(/ /, $buffer))[0];
	}
	return($buffer);
}

# ****************************************************************************
# sub isQUIT - parse given string for quit (response 221) and return result,
#			   no handling with relay at all
#					parameters:
#					- debug, if 1 then print buffer to LOG
#					- nosplit, if 0 then check buffer up to first blank
#					- buffer, is parsed for QUIT or quit
# ****************************************************************************
sub isQUIT {
	my($debug)   = shift;
	my($nosplit) = shift;
	my($buffer)  = @_;
	doLOG($debug, "! start isQUIT\n");

	if ($nosplit) {
		;
	}
	else {
		$buffer = (split(/ /, $buffer))[0];
	}

	if ($buffer eq "221") {
		$buffer = 1;
	}
	else {
		$buffer = 0;
	}

	doLOG($isdebug, "! isquit: $buffer\n");
	return($buffer);
}

# ****************************************************************************
# sub doLOG - do logging into given file
#					parameters:
#					- debug, if 1 then logging is active
#					- buffer, string to log
# ****************************************************************************
sub doLOG {
	my($debug)   = shift;
	my($buffer)  = @_;
	my($exclusive_lock) = 2;
	my($unlock_lock) = 8;

	if ($debug == 1) {
		if (! (-e $logfile)) {
			if (open (LOGFILE, ">". $logfile)) {
				flock (LOGFILE, $exclusive_lock);
				print LOGFILE $buffer;
				flock (LOGFILE, $unlock_lock);
				close (LOGFILE);
			}
			else {
				print STDERR ("Error: logfile \"$logfile\" wasn't created!\n");
			}
		}
		else {
			if (! ((-r $logfile) && (-w $logfile)) ) {
				print STDERR ("Error: can't open logfile \"$logfile\"!\n");
			}
			else {
				open (LOGFILE, ">>". $logfile);
				flock (LOGFILE, $exclusive_lock);
				print LOGFILE $buffer;
				flock (LOGFILE, $unlock_lock);
				close (LOGFILE);
			}
		}
	}
	return(0);
}

# ****************************************************************************
# sub logLTIME - do logging of time
#					parameters:
#					- mailer
#					- action
# ****************************************************************************
sub logLTIME {
	my($mailer)  = shift;
	my($action)  = @_;
	my $localtime = scalar localtime;
	doLOG($islogging, "$mailer $action at $localtime\n");

	return(0);
}

# ****************************************************************************
# Version history:
#	  - 0.1.5 / 2003-04-02 / sending disclaimer added, minor fixes
#	  - 0.1.4 / 2003-03-31 / initial public release
# ****************************************************************************
# EOF