#!/usr/bin/perl
#
#
use strict;
use lib '/usr/lib/benno-exchange';
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 LWs::Exchange2003;
use LWs::Exchange2007;

my $VERSION = '2.8.1';

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

help_exit() if $opts{h};

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

my $conf;
if ($opts{c}) {
    $conf = read_config($opts{c});
}


my $DEBUG    = $conf->{DEBUG}     || $opts{D};
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} || 250;
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 $keeperr  = $conf->{keeperror} || $opts{R};
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};

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

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


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

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

my @whitelist;
if ($whitelist) {
    @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;
    }

}
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 ($fh,$tmpfile);
    eval {
        ($fh,$tmpfile) = tempfile($count.'_XXXXXXXXXXXX',
                                  DIR => $inbox,
                                  SUFFIX => '');
    };
    if ($@) {
        my $msg = "Cannot open temporary file $tmpfile: $@";
        syslog('ERR',$msg);
        print STDERR "$msg\n" if $VERBOSE;
    
    }

    my $journal_msg = $pop->HeadAndBody($count);

    if (!$journal_msg) {	# MSG cannot be read
        if (! $fh->close) {
            croak "Cannot write tempfile $tmpfile: $!\n";
        } 
        unlink $tmpfile;
        syslog('ERR',"Cannot fetch mail $count\n");
        if ($delete && $force_delpop) {
            $pop->Delete($count);
            next;
        }
    }

    if ($jcopy) {
        # save journal mail copy
        eval {
            save_journalmail($tmpfile.'.jrnl',$journal_msg);
        };
        if ($@) {
            syslog('ERR',"Cannot save journalmail $count\n");
            die "Error save journalmail. $@\n" if $VERBOSE;
        }
    }
    # download and parse messages
    my ($message,$sender,@recipients);
    eval {
        if ($type == '2003') {
            ($message,$sender,@recipients) = LWs::Exchange2003::parse_journalmail($journal_msg);
        }
        else {
            ($message,$sender,@recipients) = LWs::Exchange2007::parse_journalmail($journal_msg);
        }
    };
    if ($@) {
        print $fh $journal_msg; # save original mail data to tmpfile
        if (! $fh->close) {
            croak "Cannot close tempfile $tmpfile: $!\n";
        }

        my $errfile = $tmpfile.'.errdnl';
        link $tmpfile, $errfile or die "Cannot link $tmpfile to $errfile: $!\n";
        unlink $tmpfile;
        my $msg = parser_error($count,$keeperr,$tmpfile,$errfile);
        $msg .= " ERRMSG: $@";

        print STDERR  "$msg" if $VERBOSE;
        syslog('ERR', $msg);
        next unless $force_delete;
    }

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

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

        print $fh $envelopemsg,$message;
        if (! $fh->close) {
            croak "Cannot write tempfile $tmpfile: $!\n";
        }
        my $emlfile = $tmpfile.'.eml';
        chmod oct $filemode, $tmpfile;
        link $tmpfile, $emlfile or die "Cannot link $tmpfile to $emlfile: $!\n";
        unlink $tmpfile;
    };
    if ($@) {
        my $msg = $@;
        syslog('INFO',"$msg") if $VERBOSE;
        print "$msg" if $VERBOSE;
        unlink $tmpfile;
        next unless $force_delete;
    }

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

    syslog('INFO',"Fetch file #$fetched from POP3 server.\n") if $VERBOSE;
    $fetched++;
}
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;
}


#
### 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;

      my $set = $val;
      $set = 1 if $val =~ /^(true|ok|yes)$/i;
      $set = 0 if $val =~ /^(false|no)$/i;
      $config->{$var} = $set;
  }
  close CONF;
  return $config;
}


### save_journalfile
#
# Stores a copy of the raw journal message
#
sub save_journalmail
{
    my ($filename,$message) = @_;

    open JOURNAL, ">$filename" or die "Cannot open journalmailfile. $!\n";
    print JOURNAL $message;
    close JOURNAL or die "Cannot close $filename: $!\n";
}


### 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;
}


### handle parser error
#
# Returns error message
#
sub parser_error {
    my ($count,$keeperr,$tmpfile,$errfile) = @_;
    my $msg = "Error parse pop3 mail #$count.";

    if ($keeperr) {
        $msg = "Error parse pop3 mail #$count.";
        if (link $tmpfile, $errfile) {
            unlink $tmpfile;
            $msg = "Error parse pop3 mail #$count.";
        }
        else {
            $msg = "Error parse pop3 mail #$count.";
        }
    }

    return $msg;
}


### 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-fetchExchange [-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 "  -K          keep mails with parser errors as .errdnl file\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::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;

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__

