#!/usr/bin/perl
#
# VERSION: 2.6.1
#
#
use strict;
use Carp;
use Getopt::Std;
use IO::File;
use Net::SMTP;
use Sys::Syslog;

our(%opts);
getopts('dDhTvwc:M:t:V:',\%opts);

if ($opts{h}) {
    print_help();
}

my %conf;
$conf{targetlist}  = $opts{t};

# compatiblity to /etc/default/benno-milter config
$conf{milterdir}   = $opts{M} || '/srv/benno/inbox';

$conf{verbose}     = $opts{v};
$conf{delete}      = $opts{d};
$conf{wipe}        = $opts{w};

$conf{starttls}    = $opts{T};
$conf{ssl_verify}  = $opts{V} || 0x00;

$conf{DEBUG}       = $opts{D};
if (!$conf{DEBUG} && $conf{verbose}) {
    $conf{DEBUG} = 1;
}
elsif ($conf{DEBUG}) {
    $conf{DEBUG} += 1;
}

if (!$conf{targetlist}) {
    print STDERR "-t <serverlist> not given!\n";
    print_help();
}

if (!$conf{host} && !$conf{targetlist}) {
    print STDERR "SMTP hostname not set!\n";
    print_help();
}

openlog('benno-smtpsend','nowaid,pid','mail');


my $Targets;
if ($conf{targetlist}) {
    $Targets = new Targets(%conf); 
}

# read directory and process files
opendir my $dh, $conf{milterdir}
    or die "Cannot read directory \"$conf{milterdir}\": $!";
logv("Read files from $conf{milterdir}.");

foreach my $file (readdir $dh) {
    next if $file =~ /^\./;
    next if $file !~ /\.eml$/;
    chomp $file;

    my $filepath = "$conf{milterdir}/$file";
    eval {
        process_mailfile("$filepath",$Targets,%conf);
    };
    if ($@) {
        $@ =~ s/\sat\s.*$//;
        print $@;
        syslog('WARNING',$@."\n");

        if ($conf{wipe}) {
            logv("Wipe skipped file: $filepath.\n");
            unlink $filepath or carp "Cannot wipe \"$filepath\": $!";
        }
    }
}
closedir $dh;



### SUBS #####################################################################

###
# read configuration from file
#
sub read_config
{
  my $configfile = shift;
  my %config;
  # _very_ simple config file parser
  #
  # Config format:   var = val
  #
  open CONF, "$configfile" or die "Cannot open config file $configfile. $!\n";
  foreach my $line (<CONF>) {
      next if $line =~ /^$/;
      next if $line =~ /^#/;
      chomp $line;
      my ($var,$val) = split(/=/, $line,2);
      # strip ws
      $var =~ s/\s//g;
      $val =~ s/^\s+//g;
      $val =~ s/\s+$//g;
      $config{$var} = $val;
  } 
  close CONF;
  return %config;
}


###
# process_mailfile
#
sub process_mailfile
{
    my ($file,$Targets,%conf) = @_;
    my $send_file = 1;
    my $target;

    logv("Transfer file: $file");
    my $Mailfile = new Mailfile($file);
    if ($send_file) {
        foreach my $envelope ($Mailfile->envelopes()) {
            $target = $Targets->get($envelope) or next;
            eval {
                logv("Send $envelope to $target",2);
                my $store_name = send_file($Mailfile,$target,%conf);
                logv("Email $file stored as $store_name on $target");
                syslog('INFO',"Email $file stored as $store_name on $target");
            };
            if ($@) {
                $@ =~ s/at.*//g;
                print STDERR $@;
                syslog('WARNING',$@."\n");
            }
        }
        if ($conf{delete}) {
            print "Remove file: $file\n" if $conf{verbose};
            syslog('INFO',"Remove file: $file");
            unlink $file or die "Cannot remove \"$file\": $!";
        }
    }
}



###
# send_file
#
sub send_file
{
    my ($Mailfile,$target,%conf) = @_;
    my $auth_user   = $conf{auth_user};
    my $auth_pass   = $conf{auth_pass};
    my $DEBUG       = $conf{DEBUG};

    my $ret;
    my ($host,$port) = split /:/, $target;
    my $smtp = Net::SMTP->new($host, Port => $port);

    if (!$smtp) {
        die "Cannot access smtp server at $target";
    }

    eval {
        $smtp->starttls('SSL_verify_mode' => $conf{ssl_verify}) if $conf{starttls};
    };
    if ($@) {
        print STDERR "Error: STARTTLS command not implemented in Perl module Net::SMTP. Please update your Perl installation.\n";
        exit 1;
    }

    if ($auth_user && $auth_pass) {
        if (!$smtp->auth($auth_user,$auth_pass)) {
            die 'SMTP AUTH failure: '.$smtp->code.' '.$smtp->message;
        }
    }

    my $envelope_from = $Mailfile->sender();
    my @envelope_to   = $Mailfile->recipients();

    logv("MAIL FROM: $envelope_from",3);
    $smtp->mail($envelope_from);            die_on_error($smtp);
    foreach my $envelope (@envelope_to) {
        logv("RCPT TO: $envelope_from",3);
        $smtp->to($envelope);               die_on_error($smtp);
    }
    $smtp->data();                          die_on_error($smtp);

    foreach my $line (@{$Mailfile->content()}) {
        $line =~ s/^\./../;                 # RFC 5321, 4.5.2. Transparency
        $smtp->rawdatasend($line);          die_on_error($smtp);
    }
    $smtp->rawdatasend("\r\n");             die_on_error($smtp);

    $smtp->debug(1);
    $smtp->dataend();                       die_on_error($smtp);
    $smtp->debug(0);
    my $smtp_response = $milter2smtp::RESPONSE;
    chomp $smtp_response;
    $smtp_response =~ s/^250\sOk:\ssaved\sas\s//i;
    $milter2smtp::RESPONSE = '';
    $smtp->quit or die "Cannot send mail to $target: $!";

    return $smtp_response.'.eml';
}


###
# smtp_error
#
sub die_on_error
{
    my ($smtp) = shift;
    if (!$smtp->ok) {
        die 'SMTP error: ',$smtp->code,' ',$smtp->message;
    }
}



###
# read_listfile
sub read_listfile
{
    my ($file) = @_;
    my @lines;
    open my $fh, '<', $file or die "Cannot open $file: $!\n";
    while (my $line = <$fh>) {
        chomp $line;
        chomp $line;
        push @lines, $line;
    }
    close $fh;
    return \@lines;
}


###
# logv
sub logv
{
    my ($msg,$level) = @_;
    $level = 0 unless $level;
    return unless $conf{DEBUG};
    if ($level < $conf{DEBUG}) {
        print "[$level]$msg\n";
    }
}


### Override class method ###
sub Net::Cmd::debug_print {
  my ($cmd, $out, $text) = @_;
  $milter2smtp::RESPONSE = $text if $text;
}




###
# print_help
#
sub print_help
{
    my ($basename) = $0 =~ m!.*?([^/]+?)$!;
    print "Call: $basename -t <file> [-M <dir>] [...]\n";
    print "\n";
    print "  -t <file>      File with archive servers by envelope-to (STDIN: --)\n";
    print "                 Format:  \@maildomain hostname:port\n";
    print "\n";
    print "  -d             Delete mail file if processed\n";
    print "  -w             Wipe skipped files from spool directory\n";
    print "  -M <directory> MILTER dump directory (/srv/benno/inbox)\n";
    print "\n";
    print "  -T             Enable STARTTLS\n";
    print "  -V             Enable SSL certificate verification (default off)\n";
    print "  -v             verbose\n";
    print "  -D <n>         debug level\n";
    print "\n";
    exit 1;
}


### EOP
1;

package Mailfile;
use strict;
use Carp;

sub new
{
    my ($class,$file) = @_;

    my $self = {
        'sender'     => '',
        'recipients' => [],
        'maildata'   => [],
    };
    bless $self, $class;

    my $fh = new IO::File;
    $fh->open($file) or die "Cannot open $file: $!\n";

    my $hname;
    my $hvalue;
    while (my $line = $fh->getline) {
        last unless $line =~ /^X-REAL-(MAILFROM|RCPTTO):/;
        if (my ($mailfrom) = $line =~ /^X-REAL-MAILFROM:\s(.*)$/) {
            $mailfrom =~ s/[\<\>\r\n]//g;
            $self->{sender} = $mailfrom;
            next;
        }
        if (my ($rcptto) = $line =~ /^X-REAL-RCPTTO:\s(.*)$/) {
            $rcptto =~ s/[\<\>\r\n]//g;
            push @{$self->{recipients}}, $rcptto;
        }
    }

    if (!$self->{sender} && !@{$self->{recipients}}) {
        croak "Skip \"$file\": Envelope header not set.";
    }

    while (my $line = $fh->getline) {
        push @{$self->{maildata}}, $line;
    }

    $fh->close;

    return $self;
}


### all
#
# returns @<envelopeaddresses>
sub envelopes
{
    my ($self) = @_;
 
    my @return;
    push @return, $self->{sender};
    
    return $self->{sender}, @{$self->{recipients}};
}


### sender
#
# returns <senderaddress>
sub sender
{
    my ($self) = @_;
 
    return $self->{sender};
}


### recipients
#
# returns @<recipientlist>
sub recipients
{
    my ($self) = @_;
 
    return @{$self->{recipients}};
}


### content
#
# returns $mailcontent without envelopes
sub content
{
    my ($self) = @_;
 
    return $self->{maildata};
}






### EOP
1;

package Targets;
use strict;


sub new
{
    my ($class,%conf) = @_;

    my $self = {};

    # defaults
    $self->{conf}->{host} = $conf{host};
    $self->{conf}->{host} .= ':'.$conf{port} if $conf{port};

    bless $self, $class;

    my $fh = new IO::File;
    my $file = $conf{targetlist};

    if ($file =~ /^--?$/) {
        $fh->fdopen(fileno(STDIN),"r");
    }
    else {
        $fh->open($file) or die "Cannot open $file: $!\n";
    }
    main::logv("Targets",1);
    while (my $line = <$fh>) {
        next if $line =~ /^\s*$/;
        next if $line =~ /^#/;
        chomp $line; chomp $line;
        my ($envelope,$targetinfo) = split /\t+/, $line;
        if (!$targetinfo) {
            main::logv("WARN: No <tab> separator found. Try <blank>.",3);
            ($envelope,$targetinfo) = split /\s+/, $line;
        }
        main::logv("$envelope => $targetinfo",1);
        $self->{target}->{$envelope} = $targetinfo;
    }
    close $fh;

    return $self;
}


### get
#
# returns <hostname>:<port>
sub get
{
    my ($self,$envelope) = @_;
    my $target = '';
    
    my ($prefix,$domain) = split /\@/, $envelope;
    $domain = '@'.$domain;

    if ($self->{target}->{$envelope}) {
        $target = $self->{target}->{$envelope};
    }
    elsif ($self->{target}->{$domain}) {
        $target = $self->{target}->{$domain};
    }
    else {
        $target = $self->{target}->{'@'};
    }

    return $target;
}

# EOP
1;



package LWs::SingleInstance;

use strict;
use Fcntl ':flock';

#
# Exit program if more than one instance is runningg
#
INIT {
    if (tell(*main::DATA) == -1) {
        # __DATA__ handle not available
        print STDERR "$0 needs an __END__ literal at the end of the file.\n";
        exit 2;
    }
    elsif (!flock main::DATA, LOCK_EX | LOCK_NB) {
        # cannot lock __DATA__ "file"
        print STDERR "An instance of $0 is already running.\n";
        exit 1;
    }
}
### EOP ###
1;
__END__

