#!/usr/bin/perl -w
# smtp2stub forking smtp proxy to sideline stub recipient mail

# (c) 2006 Julian Haight,           http://www.julianhaight.com/
# All Rights Reserved under GPL:    http://www.gnu.org/licenses/gpl.txt

# Version history
# 4/8/2006 V1.
# based on salter V1.4.

# add stub url to smtp output

use strict; 

use Stubmail;
use FileHandle; 
use Net::CIDR;
use Socket; 
use POSIX qw(:sys_wait_h);

my($CONFIG) = ($ENV{HOME} . '/.stub'); 
my($MAPFN) = "$CONFIG/map.txt";
my($CONFFN) = "$CONFIG/stub.conf";
my($EOL) = "\015\012";
my($debug) = 0;
my(@relay);
my($SMTPTO) = 10; # 10 second timeout
my($VERSION) = 'V1.0';

my($SAMP) = ' 

# here is a sample config file:

listenport	2525
listenip	127.0.0.1
sendport	25
sendip		your_isps_mailserver.example.com
maxclient	5
# space delimited list of CIDR or ip addresses (127.0.0.1 is default anyway)
relayfor	127.0.0.1

# end sample config!
';

my(%config);
unless (-e $CONFIG) { mkdir($CONFIG); }
readConfig(); # read the config file into %config
listenLoop(); # work 'til you die!
exit 0;

sub listenLoop {
    my($cliaddr, $pid, $server, $client);

    $server = new IO::Socket::INET(LocalPort => $config{'listenport'},
				   LocalAddr => $config{'listenip'},
				   Proto     => 'tcp',
				   ReuseAddr => 1,
				   Listen    => $config{maxclient} );
    
    
    print STDERR "pid $$ listening on $config{'listenip'}:$config{'listenport'} sending to $config{'sendip'}:$config{'sendport'}\n";
    sub reap {
	print STDERR "reap " . wait() . "\n";
    }
    $SIG{CHLD} = \&reap;

    # don't know why, I have a bug- when child exits, accept returns
    # undef the next time around.  
    while (1) {
	if ($client = $server->accept()) {
	    if ($pid = fork()) {
		$client->close();
	    } else {
		if ($_ = proxyIt($client)) { print STDERR "$_\n"; }
		$client->close();
		exit 0;
	    }
	} else {
	    print STDERR "No client found on accept, sleeping.\n";
	    sleep(1);
	}
    }
    print STDERR "parent $$ died for some reason\n";
}

sub proxyIt {
    my($CLI, $cliaddr) = @_;
    my($cliport, $cliip, $cmds, $head, $body, $cmd, $msgid, $relayok);

    $cliip = $CLI->peeraddr(); $cliport = $CLI->peerport();
#    ($cliport, $cliip) = (sockaddr_in($cliaddr));
	print STDERR sprintf("pid %s connected to %s:%d\n", $$, 
			     inet_ntoa($cliip), $cliport);

    $body = '';
    $cmds = ''; 
    $relayok = eval {
	Net::CIDR::cidrlookup(inet_ntoa($cliip), @relay);
      };
    
    if (!defined($relayok)) {
	print $CLI "500 config error - relay setting\n";
	return "Relay config error";
    } elsif ($relayok == 0) {
	print $CLI "500 relaying denied from your ip$EOL";
	return "Relaying denied";
    }
    # read smtp
    print $CLI "220 localhost SMTP pretender: smtp2stub $VERSION $EOL";
    while ($cmd = <$CLI>) {
	$cmds .= $cmd || '';
	if (lc($cmd) eq "data$EOL") { last; }
	if (lc(substr($cmd, 0, 4)) eq 'ehlo') {
	    print $CLI "250-pleased to meet you$EOL";
	    print $CLI "250-8BITMIME$EOL";
	   print $CLI "250 PIPELINING$EOL";
       } elsif (lc(substr($cmd, 0, 4)) eq 'quit') {
	   print $CLI "221 closing connection$EOL";
	   close $CLI;
	   return undef();
       } else {
	   print $CLI "250 ok$EOL";
       }
   }
   print $CLI "354 Ready for data$EOL";
   # read head
   while ($cmd = <$CLI>) {
       if ($cmd eq $EOL) { last; }
       if ((!$config{stripsender}) || ($cmd !~ m/^sender:/i)) {
	   $head .= $cmd;
       }
   }
   # read body
   while ($cmd = <$CLI>) {
       if ($cmd eq ".$EOL") { last; }
       $body .= $cmd;
   }
   while ($CLI && print $CLI "250 Buffering$EOL") {
       $cmd = <$CLI>;
       $cmds .= $cmd;
       if (lc($cmd) eq "quit$EOL") { last; }
   }
   if ($head =~ m/message-id: (\S+)/i) { $msgid = $1; }
   print "Accepted message $msgid\n";
   deliverAll($cmds, $head, $body);
   print $CLI "221 Bye bye, hopefully it'll work!$EOL";
   return undef();
}

sub deliverAll {
    my($cmds, $head, $body) = @_;
    my($message, $line, $remap, $recip, $sender, $cmd, $val, $S,
       @recips, $from);
#    print STDERR "Deliverall:\n$cmds\n==\n$head\n--\n$body\n++\n";
    while ($cmds =~ m/([^:\n]*): ?\<?([^\>\n]*[^\s\>])?\>?/g) {
	$cmd = lc($1); $val = $2;
#	print "cmd: $cmd = $val\n";
	if ($cmd eq 'mail from') {
	    $sender = $val;
	} elsif ($cmd eq 'rcpt to') {
	    $recip = $val;
	    push(@recips, $recip);
	}
    }
#    print STDERR "Done w/commands\n";
    while ($_ = smtpsend::smtpOpen(*S)) {
	print STDERR "Cannot open smtp: $_, sleeping..\n";
	sleep(3);
    }
#    print STDERR "Smtp open\n";
    $message = 'X-Mailer-Addon: smtp2stub ' . $VERSION . 
	' ' . $EOL . $head . $EOL . $body;
    foreach $recip (@recips) {
	if ((Stubmail::acceptsStubs($recip)) &&
	    (Stubmail::saveStubMail
	     ($sender, $recip, 
	      'From <' . $sender . '> ' . scalar(localtime()) . $EOL . 
	      $message, $config{nosign}))) {
	    
	  } elsif (($_ = smtpsend::smtpEnvelope(\*S, $sender, $recip)) ||
		   ($_ = smtpsend::smtpData(\*S, $message))) {
#	    die "Error during delivery: $_";
	      print STDERR ("Failed to send: $_ saving in $CONFIG/failed.txt");
	      open (SAVE, ">>$CONFIG/failed.txt");
	      print SAVE $message;
	      close(SAVE);
	  } else {
	      print "Message delivered: $sender -> $recip\n";
	  }
    }
    smtpsend::smtpClose(\*S);
}

sub readConfig {
    my($line);
    my($fn) = $CONFFN;
    unless (-e $fn) {
	print STDERR "smtp2stub not configured.  Please create $fn.  Sample:
$SAMP
";
	exit 1;
    }
    open (CONFIG, $fn) || die "$fn $!";
    while ($line = <CONFIG>) {
	if ($line =~ m/^([^\#;\s]\S+)\s*(\S+)\s*(\S*).*$/) {
	    $config{$1} = $2;
#	    print STDERR "$1 = $2\n";
	}
    }
    if ($config{relay}) { 
	my($cidr);
	foreach $cidr (split(/[, ]/, $config{relay})) {
	    if ($cidr =~ m/[\d\.]+/) {
		$cidr .= '/32';
	    }
	    push(@relay, $cidr);
	}
    } else {
	push(@relay, '127.0.0.1/32');
    }
}

sub errlog {
    print STDERR "@_\n";
}

sub test {
    return Stubmail::test();
    my($sender, $recip) = ('test@stubmail.julianhaight.com', 
			   'mengwong@rssemail.mailzone.com');
}

package smtpsend;
# (C) 2002, 2003 Julian Haight.  All rights reserved
# original sendmail 1.21 by Christian Mallwitz.
# Modified and 'modulized' by ivkovic@csi.com
# totally mangled by julian
# adapted for salter 3/13/04

sub smtpSend {
    my($message, $fromaddr, @recips) = @_;
    
    unless ($message) {
	errlog ("Refusing to send empty email $fromaddr -> @recips");
	return undef();
    }		    
    if ($debug) { errlog("trying smtpSend"); }
	
    # now, isn't that pretty?
    if (($_ = smtpOpen(\*S)) ||
	($_ = smtpEnvelope(\*S, $fromaddr, @recips)) ||
	($_ = smtpData(\*S, $message)) ||
	($_ = smtpClose(\*S))) {
	return ("smtpSend:" . $_);
    } else {
	return undef();
    }
}

sub smtpOpen {
    use Socket; 
    my($fh) = @_;
    my($k, $proto, $smtpaddr);
    ($smtpaddr) = (gethostbyname($config{sendip}))[4];
    
    my $save_w = $^W;
    local $/;
    $/ = "\015\012";
    
    $proto = (getprotobyname('tcp'))[2];
    unless (defined($smtpaddr)) {
	return ("smtpOpen: smtp host unknown:'" . $config{sendip} . "'");
    }
    # open socket and start mail session
    if (!socket($fh, AF_INET, SOCK_STREAM, $proto)) {
        return ("smtpOpen: socket failed ( $! )");
    }

    # connect
    if (!connect($fh, pack('Sna4x8', AF_INET, $config{sendport}, $smtpaddr))) {
	if ($! eq 'Interrupted system call') {
	    return "smtpOpen: timeout after $SMTPTO seconds during connect";
	} else {
	    return ("smtpOpen: connect to smtp server failed ($!)");
	}
    }
    my($oldfh) = select($fh); $| = 1; select($oldfh);
    if (($_ = smtpExchange($fh)) !~ m/^[23]/) {
        return ("smtpOpen: smtpsend connection error from smtp server ($_)");
    }
    if (($_ = smtpExchange($fh, "HELO smtp2stub" . $VERSION)) !~ m/^[23]/) {
	return ("smtpOpen: smtpsend HELO error ($_)");
    }
    return undef();
}

sub smtpEnvelope {
    my($fh, $from, @recips) = @_;
    if (($_ = smtpFrom($fh, $from)) || ($_ = smtpTo($fh, @recips))) {
	return "smtpEnvelope ($from, @recips): $_";
    }
    return undef();
}

sub smtpFrom {
    my($fh, $from) = @_;
    if (($_ = smtpExchange($fh, "MAIL FROM: <$from>")) !~ m/^[23]/) {
        return ("smtpFrom: mail From $from: error ($_)");
    }
    return undef();
}

sub smtpTo {
    my($fh, @recips) = @_;
    my($to);
    unless (@recips) { return ("No recipient!") }
    foreach $to (@recips) {
	unless ($to) { 
	    errlog("Null recipient in smtpTo, skipping");
	    next; 
	}
	if (($_ = smtpExchange($fh, "RCPT TO: <$to>")) !~ m/^[23]/) {
	    return ("smtpTo rcpt to:$to ($_)");
        }
    }
    return undef();
}
    
sub smtpData {
    my($fh, $data) = @_;
    $data =~ s/^\./\.\./gm;     # handle . as first character
    if ($_ = smtpBeginData($fh)) { return $_; }
    smtpOutput($fh, $data);
    if ($debug) { errlog("Wrote " . length($data) . " bytes of data"); }
    return smtpEnd($fh);
}

sub smtpOutput {
    my($fh, $data) = @_;
    my($i, $c, $lc);

    for ($i = 0; $i < length($data); $i++) {
	$c = substr($data, $i, 1);
	if (($c eq "\012") && ($lc ne "\015")) {
	    print $fh "\015";
	}
	$lc = $c;
	print $fh $c;
    }
}

sub smtpBeginData {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "DATA")) !~ m/^[23]/) {
	return ("smtpBeginData: Cannot send data ($_)");
    }
    return undef();
}

sub smtpRset {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "RSET")) !~ m/^[23]/) {
	return ("smtpRset: Cannot rset smtp ($_)");
    }
    return undef();
}

sub smtpEnd {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "\015\012.")) !~ m/^[23]/) {
	return ("smtpEnd: message transmission failed: $_");
    }
    return undef();
}

sub smtpClose {
    my($fh) = @_;
    my($code) = smtpExchange($fh, "QUIT");
    close $fh;

    if ($code !~ m/^[23]/) {
	return ("smtpClose: cannot quit: $_");
    } else {
	return undef();
    }
}

sub smtpExchange {
    my($fh, $cmd) = @_;
    my($resp);
    if ($cmd) {
	print $fh ($cmd . "\015\012");
	if ($debug) { errlog(">> $cmd"); }
    }
    while (defined($resp = <$fh>) && ($resp !~ m/^(\d+)\s/)) {
	if ($debug) { errlog("<. $resp"); }
    }
    chomp($resp);
    if ($debug) { errlog("<< $resp"); }
    return $resp;
}

1;