#!/usr/bin/perl

#
# Simple utility to send authenticated messages.
#
# Copyright (C) 2007 Entercore, Ltda.
# Rodrigo Madera
#

use Net::SMTP;
use MIME::Base64;
use Getopt::Long;
use IO::Socket;

%accounts = ();
$accounts { "XXX"  } = "XXXPASS";
$accounts { "YYY" } = "YYYPASS";

$account = "";
$forcedFrom = "";
$daemon = 0;
$help = 0;

sub printUsageAndExit {
	print STDERR "Usage:\n";
	print STDERR "\n";
	print STDERR "ec-mailer <--account=acct> [--force-from=email@address.com]\n";
	print STDERR "ec-mailer --daemon\n";
	print STDERR "\n";
	print STDERR "\taccount		{ twiki, scarab, etc }\n";
	print STDERR "\tforce-from	Force the FROM field to be this account.\n";
	print STDERR "\tdaemon		Run a SMTP server on this machine.\n";
	print STDERR "\thelp		This usage help text.\n";
	print STDERR "\n";
	exit -1;
}

sub _fixLineLength {
	my( $addrs ) = @_;
	# split up header lines that are too long
	$addrs =~ s/(.{60}[^,]*,\s*)/$1\n        /go;
	$addrs =~ s/\n\s*$//gos;
	return $addrs;
}

sub sendEmail {
	my($username, $password, $text) = @_;

	my $from = '';
	my @to = ();

	my ( $header, $body ) = split( "\n\n", $text, 2 );
	my @headerlines = split( /\r?\n/, $header );
	$header =~ s/\nBCC\:[^\n]*//os;  #remove BCC line from header
	$header =~ s/([\n\r])(From|To|CC|BCC)(\:\s*)([^\n\r]*)/$1 . $2 . $3 . _fixLineLength( $4 )/geois;
	$text = "$header\n\n$body";   # rebuild message

	# extract 'From:'
	if ($forcedFrom ne "") {
		$from = $forcedFrom;
	} else {
		my @arr = grep( /^From: /i, @headerlines );
		if( scalar( @arr ) ) {
		        $from = $arr[0];
		        $from =~ s/^From:\s*//io;
		        $from =~ s/.*<(.*?)>.*/$1/o; # extract "user@host" out of "Name <user@host>"
		} unless( $from ) {
			print STDERR "ERROR: Can't send mail, missing 'From:'\n";
			return;
		}
	}

	# extract @to from 'To:', 'CC:', 'BCC:'
	@arr = grep( /^To: /i, @headerlines );
	my $tmp = '';
	if( scalar( @arr ) ) {
		$tmp = $arr[0];
		$tmp =~ s/^To:\s*//io;
		@arr = split( /,\s*/, $tmp );
		push( @to, @arr );
	}

	@arr = grep( /^CC: /i, @headerlines );
	if( scalar( @arr ) ) {
		$tmp = $arr[0];
		$tmp =~ s/^CC:\s*//io;
		@arr = split( /,\s*/, $tmp );
		push( @to, @arr );
	}

	@arr = grep( /^BCC: /i, @headerlines );
	if( scalar( @arr ) ) {
		$tmp = $arr[0];
		$tmp =~ s/^BCC:\s*//io;
		@arr = split( /,\s*/, $tmp );
		push( @to, @arr );
	}

	if (!(scalar(@to))) {
		print STDERR "ERROR: Can't send mail, missing recipient\n";
		return;
	}

	return undef unless( scalar @to );

	# Change SMTP protocol recipient format from
	# "User Name <userid@domain>" to "userid@domain"
	# for those SMTP hosts that need it just that way.
	foreach (@to) {
		s/^.*<(.*)>$/$1/;
	}

	$smtp = Net::SMTP->new(
		'smtp.entercore.com' ,
		Hello => "client.entercore.com",
		Timeout => 10,
		Debug   => 1,
	) || die "Couldn't connect to mail server.\n";

	my $status = '';

	$smtp->rawdatasend("AUTH LOGIN\n");
	$smtp->response();
	$smtp->rawdatasend(encode_base64($username));
	$smtp->response();
	$smtp->rawdatasend(encode_base64($password));
	$smtp->response();

	$smtp->mail($from) || die $mess.$smtp->message;
	$smtp->to(@to, { SkipBad => 1 }) || die $mess.$smtp->message;

	$smtp->data($text) || die $mess.$smtp->message;
	$smtp->quit();
}

# Implementation of a listening server...
$client;
sub mailServer {
	my $server = IO::Socket::INET->new(LocalPort => 25,
					   Type => SOCK_STREAM,
					   Reuse => 1,
					   Listen => 10)
	|| die "ERROR: Couldn't open server on port $port";

	STDOUT->autoflush(1);

	while ($client = $server->accept()) {
		$client->send("220 Entercore Mailer Daemon\r\n");

		my $running = 1;
		while ($running) {
			my $command = receiveLine();
			print ">>> $command\n";
			if (!$command || $command eq "QUIT") {
				sendLine("221 Goodbye.");
				$client->close();
				last;
			} elsif ($command =~ /^MAIL FROM:/) {
				$from = $command;
				$from =~ s/^MAIL FROM:\s*//io;
				$from =~ s/.*<(.*?)>.*/$1/o;
				sendLine("250 Proceed.");
			} elsif ($command =~ /^RCPT TO:/) {
				(undef, $to) = split(/:/, $command, 2);
				sendLine("250 Proceed.");
			} elsif ($command eq "DATA") {
				sendLine("354 Ready for data");
				$data = receiveData();
				sendLine("250 Proceed.");
			} else {
				sendLine("250 Proceed.");
			}
		}

		($account, undef) = split(/@/, $from, 2);
		if (!exists($accounts{$account})) {
			print STDERR "ERROR: Account not found: ${account}\n";
		} else {
			print "From {$from}\n";
			print "To {$to}\n";
			print "Data {$data}\n";
			print "username=$username\n";

			$username = $account."=entercore.com";
			$password = $accounts{$account};
			$input = "MAIL FROM: $account@entercore.com\r\n";
			$input .= "RCPT TO: $to\r\n";
			$input .= "DATA\r\n";
			$input .= "$data";
			$input .= "QUIT\r\n";

			print "input={$input}\n";
			sendEmail($username, $password, $input);
		}
	}
}

sub sendLine {
	my $message = $_[0];
	$client->send("$message\r\n");
	print "<<< $message\n";
}

sub receiveLine {
	my $line;
	$client->recv($line, 1024);
	return decodeLine($line);
}

sub receiveData {
	my $fullLine;
	my $line;
	while ($fullLine !~ /[\r\n]\.[\r\n]/) {
		$client->recv($line, 255);
		$fullLine .= $line;
	}

	return $fullLine;#decodeLine($fullLine);
}

sub decodeLine {
	my $line = $_[0];

	if ($echo) {
		my $visline = $line;
		$visline =~ s/\r/\\r/g;		# make \r visible
		$visline =~ s/\n/\\n/g;		# make \n visible
		$visline =~ s/(\\r|\\n)([^\\])/$1\n<$2/g;	# break line after '\r', '\n', '\r\n, or '\n\r'
		$visline =~ s/(\\r\\n)(\\r\\n)/$1\n<$2/g;	# break line between adjacent sets of '\r\n'
		print "<$visline\n";
	}
	$line =~ s/[\r\n]//g;
	return $line;
}

##
## main()
##

GetOptions(
	'account=s' => \$account,
	'forced-from=s' => \$forcedFrom,
	'daemon!' => \$daemon,
	'help!' => \$help,
) or printUsageAndExit();

if ($help || ($account eq "" && !$daemon)) {
	printUsageAndExit();
}

if ($daemon) {
	mailServer();
	exit 0;
}

if (!exists($accounts{$account})) {
	print STDERR "ERROR: Account not found\n";
	exit -1;
}

$username = $account."=entercore.com";
$password = $accounts{$account};

$input = join("", <STDIN>);
sendEmail($username, $password, $input);