#!/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.7-1';

my %opts;
getopts('A:DSdfFhjsvVH:L:M:P:R:S:c:i: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;
}

openlog('benno-exchange','nowait,pid','mail');


my $Lock;
my $conf;
eval {
    if ($opts{c}) {
        $Lock = LWs::Lock->new($opts{c});
        $conf = read_config($opts{c});
    }
    else {
        $Lock = LWs::Lock->new();
    }
};
if ($@) {
    print STDERR $@;
    syslog('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};

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

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

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

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

my @whitelist;
if ($whitelist) {
    print "Read whitelist from $whitelist\n" if $DEBUG;
    @whitelist = read_whitelist($whitelist);
}
my $socket;
if ($ssl) {
    $IO::Socket::SSL::DEBUG = $ENV{SSLDEBUG} if $ENV{SSLDEBUG};
    $port = 995 if $port == 110;
    $socket = IO::Socket::SSL->new(
        Proto           => 'tcp',
        PeerAddr        => $host,
        PeerPort        => $port,
        SSL_verify_mode => 0x00,
        $ssl_version ? (SSL_version => $ssl_version) : (),
    );

    if (!$socket) {
        my $msg = "ERROR connecting \"$host:$port\": ";
        if ($SSL_ERROR) {
            $msg .= $SSL_ERROR;
        }
        else {
            $msg .= "$!";
        }
        print STDERR "$msg\n";
        exit 1;
    }

    $authmode = 'PASS' if $authmode eq 'BEST';
}
else {
    $socket = IO::Socket::INET->new(
        Proto    => 'tcp',
        PeerAddr => $host,
        PeerPort => $port,
    );
}



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: $@";
    syslog('ERR',"Error access $host on port $port: $@");
    exit 2;
}

my $num = $pop->Count();
if ($num < 0) {
    my $ERRMSG = $pop->Message;
    print STDERR "Error retrieve message counter: $ERRMSG\n";
    syslog('ERR',"Error retrieve message counter: $ERRMSG\n");
}

print "$num mails on server.\n" if $VERBOSE;
syslog('INFO',"$num mails on server.\n") if $VERBOSE;

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
        syslog('ERR',"Cannot fetch mail $count\n");
        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 = $@;
            syslog('ERR',"Error save journalmail $count: $errmsg\n");
            print STDERR "Error save journalmail $count: $errmsg\n" if $VERBOSE;
        }
    }

    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 = $@;
        my $msg = "Error parse pop3 mail #$count: $errmsg";
        eval {
            my $header = new MIME::Parser->parse_data($journal_msg)->head;

            my $ErrFile = Benno::Mailfile->new($journal_msg,$filemode);
            my $errname = $ErrFile->save($inbox,$count.'.errdnl');
            $pop->Delete($count) if $delete;

            $msg .= "  Save as $errname.";
            print STDERR  "$msg\n" if $VERBOSE;
            syslog('ERR', $msg);
        };
        if ($@) {
            my $errmsg = $@; 
            syslog('ERR',"Cannot save errormail $count: $errmsg\n");
            print STDERR "Error save errormail $count: $errmsg\n" if $VERBOSE;
        }

        next;
    }

    # save mail in inbox
    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);
        $EmlFile->save($inbox,$count.'.eml');

    };
    if ($@) {
        my $msg = $@;
        syslog('INFO',"$msg") if $VERBOSE;
        print "$msg" if $VERBOSE;
        next unless $force_delete;
    }

    $pop->Delete($count) if $delete;

    syslog('INFO',"Fetch file #$fetched from POP3 server.\n") if $VERBOSE;
}
print "\n" if $VERBOSE;

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

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

# 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>] [-D] -u <user> -p <pass> [-i <inbox dir>] [-H <host>] [-n <num>] [-w <file>] [-s] [-j] [-S] [-v] [-k]\n";
    print "  -c <config> read configuration from file\n";
    print "  -D          print debug messages\n";
    print "  -u <user>   pop3 username\n";
    print "  -p <pass>   pop3 password\n";
    print "  -i <dir>    Benno inbox (/srv/benno/inbox)\n";
    print "  -H <host>   hostname (localhost)\n";
    print "  -M <mode>   file mode (default 0640)\n";
    print "  -P <port>   port (110)\n";
    print "  -n <num>    fetch num mails per run (200)\n";
    print "  -d          delete mails on pop3 server\n";
    print "  -s          ssl connect to pop3s (default port 995)\n";
    print "  -L <SSL_V>  SSL version (TLSv1 | TLSv11 | TLSv12 | TLSv13)\n";
    print "  -t 2003     MS Exchange 2003 journal format (default >= 2007)\n";
    print "  -j          save file with raw journalmail (.jrnl)\n";
    print "  -f          force deletion on POP server on parse errors\n";
    print "  -F          force deletion on POP server on download errors\n";
    print "  -R <userid> run as <userid> (default benno)\n";
    print "  -A <mode>   force authentication mode (PASS, APOP, CRAM-MD5)\n";
    print "  -S <file>   write current fetch status to file\n";
    print "  -w <file>   whitelist with adresses / \@domains to import (one per line)\n";
    print "  -X          extra header name written to each mail (default: X-BENNO-GW)\n";
    print "  -x          extra header value written to each mail (setting enables)\n";

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

### EOP ###
1;


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__

