#!/usr/bin/perl
#
#
use strict;
use lib '/usr/lib/benno-exchange';
use Fcntl ':flock';
use Getopt::Std;
use Sys::Syslog;
use IO::Socket;
use IO::Socket::SSL;
use File::Temp qw/tempfile/;
use IO::File;
use Mail::POP3Client;
use MIME::Parser;
use Carp;
use Benno::Exchange2003;
use Benno::Exchange2007;
use Benno::Mailfile;

my $VERSION = '2.8.12';

my %opts;
getopts('A:DSdfFhjsvVH:L:M:P:R:S:c:i:l:m:n:p:t:u:w:x:X:',\%opts);

help_exit() if $opts{h};
my $DEBUG = $opts{D};

if ($opts{V}) {
    print "benno-exchange $VERSION\n"; exit 0;
}


my $Log;
my $Lock;
my $conf;
eval {
    if ($opts{c}) {
        $Lock = LWs::Lock->new($opts{c});
        $conf = read_config($opts{c});
        $Log = new LWs::Log($conf->{logfile} || $opts{l});
    }
    else {
        $Lock = LWs::Lock->new();
    }
};
if ($@) {
    print STDERR $@;
    $Log->write($@,'ERR');
    exit 1;
}

my $delete   = $conf->{delete}    || $opts{d};
my $ssl      = $conf->{ssl}       || $opts{s};
my $VERBOSE  = $conf->{VERBOSE}   || $opts{v};
my $host     = $conf->{host}      || $opts{H} || 'localhost';
my $port     = $conf->{port}      || $opts{P} || 110;
my $inbox    = $conf->{inbox}     || $opts{i} || '/srv/benno/inbox';
my $numfetch = $conf->{numfetch}  || $opts{n} || 1000;
my $pass     = $conf->{pass}      || $opts{p};
my $type     = $conf->{type}      || $opts{t} || '2007';
my $user     = $conf->{user}      || $opts{u};
my $jcopy    = $conf->{jcopy}     || $opts{j};
my $runuser  = $conf->{runuser}   || $opts{R} || 'benno';
my $authmode = $conf->{authmode}  || $opts{A} || 'BEST';
my $statusfile = $conf->{statusfile}  || $opts{S};
my $whitelist = $conf->{whitelist}    || $opts{w};
my $force_delete = $conf->{force_delete} || $opts{f};
my $force_delpop  = $conf->{force_delpop} || $opts{F};
my $filemode = $conf->{filemode}    || $opts{M} || '0640';
my $extraheader_name  = $conf->{extraheader_name}  || $opts{X} || 'X-BENNO-GW';
my $extraheader_value = $conf->{extraheader_value} || $opts{x};
my $ssl_version = $conf->{ssl_version} || $opts{L};
my $warncount  = $conf->{warncount}  || 5000;   # warn if mailbox count > 5000

$DEBUG = $DEBUG || $conf->{DEBUG};

help_exit() if not ($user and $pass);

LWs::RunAs->import($runuser);

$port = 995 if ($ssl) && ($port == 110);

$0 = "benno-exchange -H $host -P $port";

my @whitelist;
if ($whitelist) {
    $Log->verbose("Read whitelist from $whitelist");
    @whitelist = read_whitelist($whitelist);
}

my $socket;
eval {
    if ($ssl) {
        $IO::Socket::SSL::DEBUG = $ENV{SSLDEBUG} if $ENV{SSLDEBUG};
        $socket = IO::Socket::SSL->new(
            Proto           => 'tcp',
            PeerAddr        => $host,
            PeerPort        => $port,
            SSL_verify_mode => 0x00,
            $ssl_version ? (SSL_version => $ssl_version) : (),
        ) or die "Cannot connect \"$host:$port\": $!";
    }
    else {
        $socket = IO::Socket::INET->new(
            Proto    => 'tcp',
            PeerAddr => $host,
            PeerPort => $port,
        ) or die "Cannot connect \"$host:$port\": $!";
    }
};
if ($@) {
    (my $msg = $@) =~ s/\R$//;
    if ($SSL_ERROR) {
        $msg .= " ($SSL_ERROR)";
    }
    $Log->error($msg);
    print STDERR "$msg\n" unless -t STDOUT;
    exit 2;
}


$authmode = 'PASS' if $authmode eq 'BEST';

my $pop = Mail::POP3Client->new();
$pop->User($user);
$pop->Pass($pass);
$pop->AuthMode($authmode);
$pop->Socket($socket);
$pop->Debug(1) if $DEBUG;

my $stderr = '';
eval {
    local *STDERR;
    open STDERR, ">", \$stderr;
    if (!$pop->Connect) {
        die "Cannot connect: ".$pop->Message."\n";
    }
    if (!$pop->Login) {
        die "Cannot login: ".$pop->Message."\n";
    }
};
if ($@) {
    print STDERR "Error access $host on port $port: $@" unless -t STDOUT;
    $Log->error("Error access $host on port $port: $@");
    exit 3;
}

$Log->info("Fetch MS Exchange journal mails from $host:$port.");

my $num = $pop->Count();
if ($num < 0) {
    my $ERRMSG = $pop->Message;
    $Log->error("Error retrieve message counter: $ERRMSG");
}
if ($num > $warncount) {
    $Log->info("WARNING Journaling mailbox contains $num ($warncount) emails.");
}

$Log->verbose("$num mails on server.");

my $count;
my $fetched=0;
for($count=1;$count<=$numfetch && $count<=$num;$count++) {
    my $journal_msg = $pop->HeadAndBody($count);
    if (!$journal_msg) {	# MSG cannot be read
        $Log->error("Cannot fetch mail $count");
        if ($delete && $force_delpop) {
            $pop->Delete($count);
        }
        $fetched++;
        next;
    }
    $fetched++;

    if ($jcopy) {
        # save journal mail copy
        eval {
            my $JrnlFile = Benno::Mailfile->new($journal_msg,$filemode);
            $JrnlFile->save($inbox,$count.'.jrnl');
        };
        if ($@) {
            my $errmsg = $@;
            $Log->error("Error save journalmail $count: $errmsg");
        }
    }

    my ($message,$sender,@recipients);
    eval {
        if ($type == '2003') {
            ($message,$sender,@recipients) = Benno::Exchange2003::parse_journalmail($journal_msg);
        }
        else {
            ($message,$sender,@recipients) = Benno::Exchange2007::parse_journalmail($journal_msg);
        }
    };
    if ($@) {
        (my $errmsg = $@) =~ s/\R//;
        my $msg = "Error parse pop3 mail #$count: $errmsg";
        eval {
            my $ErrFile = Benno::Mailfile->new($journal_msg,$filemode);
            my $errname = $ErrFile->save($inbox,$count.'.errdnl');
            $msg .= "  Save as $errname.";
            $Log->error($msg);

            if ($delete) {
                $Log->verbose("Delete message #$fetched from $host:$port");
                $pop->Delete($count);
            }
        };
        if ($@) {
            (my $errmsg = $@) =~ s/\R//; 
            my $msg = "Cannot save errormail $count: $errmsg";
            $Log->error($msg);
        }

        next;
    }

    # save mail in inbox
    my $savename;
    eval {
        my $in_whitelist;
        $in_whitelist = check_whitelist($sender,@whitelist);
        my $envelope = "X-REAL-MAILFROM: ".lc $sender."\r\n"; 
        for my $recipient (@recipients) {
            $in_whitelist = check_whitelist($recipient,@whitelist);
            $envelope .= "X-REAL-RCPTTO: ".lc $recipient."\r\n";
        }
        if ($extraheader_value) {
            $envelope .= "$extraheader_name: $extraheader_value\r\n";
        }

        if ($whitelist) {
            die "Sender / Recpient not in whitelist. Skip." if not $in_whitelist;
        }

        my $mailmsg = $envelope . $message;
        my $EmlFile = Benno::Mailfile->new($mailmsg,$filemode);
        $savename = $EmlFile->save($inbox,$count.'.eml');
        my $msg = "Save message #$fetched with id \"".$EmlFile->msgid."\" as $savename";
        $Log->info($msg);
    };
    if ($@) {
        (my $msg = $@) =~ s/\R//;;
        $Log->error("Cannot save email #$fetched: $msg");
        next unless $force_delete;
    }

    if ($delete) {
        $Log->verbose("Delete message #$fetched from $host:$port");
        $pop->Delete($count);
    }

}

$pop->Close();
print "Fetched $fetched files from POP3 server.\n" if -t STDOUT;

if ($conf->{statusfile}) {
    open my $sfh, ">$conf->{statusfile}" or croak "Cannot open $conf->{statusfile}: $!\n";
    my $timestamp = time();
    print $sfh "$timestamp: $fetched\n";
    $Log->verbose("Status: $timestamp: $fetched");
    close $sfh;
}

# release lock
$Lock->release();
exit 0;


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

###
#
# read configuration from file
#
sub read_config
{
  my $configfile = shift;
  my $config = {};
  # _very_ simple config file parser
  #
  # Config format:   var = val
  #
  open my $confh, "$configfile" or die "Cannot open config file $configfile. $!\n";
  foreach my $line (<$confh>) {
      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;

      if ($val =~ /^\</) {  # read file content
        $val = _file_value($val,$var);
      }
      my $set = $val;
      $set = 1 if $val =~ /^(true|ok|yes)$/i;
      $set = 0 if $val =~ /^(false|no)$/i;
      $config->{$var} = $set;
  }
  return $config;
}


### import whitelist from file
#
# Reads the list of adresses to import
#
sub read_whitelist
{
    my ($wlfile) = @_;

    my @whitelist;
    open my $wl, '<', $wlfile;
    chomp(my @whitelist = <$wl>);
    close $wl;

    return @whitelist;
}


### check if address(es) in whitelist
#
# dies if not in whitelist
#
sub check_whitelist
{
    my ($address,@whitelist) = @_;
    my $iswl = 0;
    foreach my $wladdr (@whitelist) {
        next if $wladdr =~ /^#/;
        next if $wladdr =~ /^$/;
        if ($wladdr =~ /^\@/) {
            $iswl = 1 if $address =~ qr/$wladdr$/;       # domain name
        }
        else {
            $iswl = 1 if $address =~ qr/^$wladdr$/;      # email address
        }
    }

    return $iswl;
}


# read config value from file
sub _file_value
{
    my ($configval,$var) = @_;
    my $retval;

    (my $file = $configval) =~ s/^\<//;
    print "Read $var from file: $file\n" if $DEBUG;
    eval {
        local $/;
        open(my $fh, '<', $file) or die "Cannot read $file: $!\n";
        $retval = <$fh>;
        close($fh);
    };
    if ($@) {
        print "NOTE $@";
        return $configval;
    }
    chomp $retval;
    return $retval;
}


### Overwrite methods for fancier debugging.
sub Mail::POP3Client::_sockprint
{
  my $me = shift;
  my $s = $me->Socket();
  $me->Debug and print STDERR ">>> ", @_;
  my $outline = "@_";
  chomp $outline;
  push(@{$me->{tranlog}}, $outline);
  print $s @_;
}

sub Mail::POP3Client::_sockread
{
  my $me = shift;
  my $line = $me->Socket()->getline();
  unless (defined $line) {
      return;
  }

  # Macs seem to leave CR's or LF's sitting on the socket.  This
  # removes them.
  $me->{STRIPCR} && ($line =~ s/^[\r]+//);

  $me->Debug and print STDERR "<<< ", $line;
  $line =~ /^[\\+\\-](OK|ERR)/i && do {
    my $l = $line;
    chomp $l;
    push(@{$me->{tranlog}}, $l);
  };
  return $line;
}

# help
#
sub help_exit
{
    print "Aufruf: benno-exchange [-c <configfile>] [arguments]\n";
    print "\n";
    print "  -c <config>  read configuration from file\n";
    print "  -D           print debug messages\n";
    print "  -l <logfile> logfile instead of syslog (logfile = /var/log/benno/exchange.log)\n"; 
    print "  -u <user>    pop3 username  (user = ...)\n";
    print "  -p <pass>    pop3 password  (pass = ...)\n";
    print "  -i <dir>     Benno inbox  (inbox = /srv/benno/inbox)\n";
    print "  -H <host>    hostname  (host = localhost)\n";
    print "  -M <mode>    file mode  (filemode = 0640)\n";
    print "  -P <port>    port  (port = 110)\n";
    print "  -n <num>     fetch num mails per run  (numfetch = 1000)\n";
    print "  -d           delete mails on pop3 server  (delete = 1)\n";
    print "  -s           ssl connect to pop3s  (ssl = 1)\n";
    print "  -L <SSL_V>   SSL version  (ssl_version = TLSv1|TLSv11|TLSv12|TLSv13)\n";
    print "  -t 2003      MS Exchange 2003 journal format  (type = 2007)\n";
    print "  -j           save file with raw journalmail  (jcopy = 1)\n";
    print "  -f           force deletion on POP server on parse errors  (force_delete = 1)\n";
    print "  -F           force deletion on POP server on download errors (force_delpop = 1)\n";
    print "  -R <userid>  run as <userid>  (runuser = benno)\n";
    print "  -A <mode>    force authentication mode  (authmode = BEST|PASS|APOP|CRAM-MD5)\n";
    print "  -S <file>    write current fetch status to file (statusfile = /path/to/file)\n";
    print "  -w <file>    whitelist file <address>|<\@domain>  (whitelist = /path/file)\n";
    print "  -X           extra header name   (extraheader_name = X-BENNO-GW)\n";
    print "  -x           extra header value  (extraheader_value = ... (enabled when set)\n";

    print "  -v           verbose\n";
    print "  -V           version info\n";
    exit 1;
}

### EOP ###
1;


package LWs::Log;
use strict;
use Sys::Syslog;

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

    my $self = {};
    bless $self, $class;

    if ($logfile) {
        open my $lh, ">>$logfile" or die "Cannot open logfile $logfile: $!\n";
        $self->{lh} = $lh;
    }
    else {
        openlog('benno-exchange','nowait,pid','mail');
    }

    return $self;
}


sub write
{
    my ($self,$logmsg,$prefix) = @_;

    if ($self->{lh}) {
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
        #                         0-11,+1900,0-6  ,0-366,SZ=(+)
        #                                   ,So-Sa,0-366,WZ=0,NA=(-)

        $year += 1900;
        $mon  += 1; $mon = sprintf("%02d",$mon);
        $mday = sprintf("%02d",$mday);
        $hour = sprintf("%02d",$hour);
        $min  = sprintf("%02d",$min);
        $sec  = sprintf("%02d",$sec);
        my $ts = "${year}-${mon}-${mday} ${hour}:${min}:${sec}";

        my $msg = $prefix.': ' if $prefix;
        $msg = $ts.' '.$msg;
        $msg .= $logmsg;
        my $lh = $self->{lh};
        print $lh $msg."\n";
    }
    else {
        $prefix = 'INFO' unless $prefix;
        syslog($prefix,$logmsg."\n");
    }
}


sub error
{
    my ($self,$logmsg) = @_;

    print STDERR "$logmsg\n" if -t STDOUT;
    $self->write($logmsg,'ERR');
}


sub info
{
    my ($self,$logmsg) = @_;

    print "$logmsg\n" if -t STDOUT;
    $self->write($logmsg,'INFO');
}


sub verbose
{
    my ($self,$logmsg) = @_;

    return unless $VERBOSE;
    print "$logmsg\n" if -t STDOUT;
    $self->write($logmsg,'DEBUG');
}


sub DESTROY {
    my $self = shift;

    close $self->{lh} if $self->{lh};
}



package LWs::Lock;
use strict;

use Fcntl ':flock';

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

    my $self = {};
    $self->{file} = $file;
    bless $self, $class;

    if (!$file) {
        print "WARN $0 could be started multiple times!\n";
        return $self;
    }
    else {
        $self->_init();
    }

    return $self;
}


sub release
{
    my $self = shift;

    flock $self->{lock}, LOCK_UN or die 'Cannot unlock '.$self->{file},"\n";
}


sub _init
{
    my $self = shift;

    open my $lockh, $self->{file} or die "Cannot lock $self->{file}. $!";
    if(!flock $lockh, LOCK_EX | LOCK_NB) {
# cannot lock __DATA__ "file"
        die "File $self->{file} is locked by another instance.\n";
    }

    $self->{lock} = $lockh;
}

### EOP ###
1;


package LWs::RunAs;

use strict;

sub import {
    my ($package,$user) = @_;
    unless( $user ){
        print STDERR __PACKAGE__." must be imported with user to run as.\n";
        exit 1;
    }
    if (($< == 0) || (getpwuid($<) eq $user)) {
        my ($uid,$gid) = (getpwnam($user))[2,3];
        $( = $gid;
                $) = $gid;
        $> = $uid;
        $< = $uid;
    }
    else {
        print STDERR "Program must be run as $user or root.\n";
        exit 2;
    }
}

### EOP ###
1;

__END__

