#!/usr/bin/perl
#
#
use strict;
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 Email::Simple;
use Carp;

my $VERSION = '2.8.6';

my %opts;
getopts('DVdhSsvA:c:H:M:P:R:n:p:r:i:T:u:X:x:',\%opts);

version_exit() if $opts{V};
help_exit() if $opts{h};

my $DEBUG    = $opts{D};
my $VERBOSE  = $opts{v};

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

my $user      = $opts{u} || $conf{user};
my $pass      = $opts{p} || $conf{pass};
my $host      = $opts{H} || $conf{host}      || 'localhost';
my $port      = $opts{P} || $conf{port};
my $runuser   = $opts{R} || $conf{runuser}   || 'benno';
my $numfetch  = $opts{n} || $conf{numfetch}  || 200;
my $inbox     = $opts{i} || $conf{inbox}     || '/srv/benno/inbox';
my $real_to   = $opts{r};
my $delete    = $opts{d};
my $ssl       = $opts{s};
my $authmode  = $opts{A} || $conf{authmode}  || 'BEST';
my $filemode  = $opts{M} || $conf{filemode}  || '0640';
my $timeout   = $opts{T} || $conf{timeout}   || 60;

my $extraheader_name  = $opts{X} || $conf{extraheader_name} || 'X-BENNO-GW';
my $extraheader_value = $opts{x} || $conf{extraheader_value};

my $suppress_verify = $opts{S}   || $conf{suppress_verify};

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

my $ERRMSG;

$0 = "benno-pop3 -H $host -P $port";
openlog('benno-pop3','nowait,pid','mail');

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

my $pop;
my $errcount = 0;
while (1) {
    eval {
        my $sock = open_socket($host,$port,$ssl,$suppress_verify,$timeout);
        if ($ssl and ($authmode eq 'BEST')) { $authmode = 'PASS'; }

        # all parameters as method or all on new(...)!
        # see: FS#1000
        $pop = Mail::POP3Client->new();
        $pop->User($user);
        $pop->User($user);
        $pop->Pass($pass);
        $pop->Socket($sock);
        $pop->AuthMode($authmode);
        $pop->Debug($DEBUG);

        if (!$pop->Connect) {
            $ERRMSG = $pop->Message;
            die "Cannot connect to $host: $ERRMSG\n";
        }
        if (!$pop->Login) {
            $ERRMSG = $pop->Message;
            die "Login failed: $ERRMSG\n";
        }
        last;
    };
    if ($@) {
        $errcount++;
        print STDERR "Error[#$errcount]: $@" if $VERBOSE;
        syslog('ERR',"Error[#$errcount] login: $@");
        sleep 5;
        next if $errcount < 10;
        syslog('ERR',"Too much login errors. Exit.");
        die "$@";
    }
}


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

print "$num mails on server.\n" if $VERBOSE;

my $count;
my $fetched=0;
for($count=1;$count<=$numfetch && $count <= $num;$count++) {
    my $maildata = $pop->HeadAndBody($count);
    my $email = Email::Simple->new($maildata);
    my ($msgid) = $email->header('Message-Id') =~ /^\<?([^\<\>]+)\>?/;
    unless ($msgid) {
        $msgid = 'NO_MSGID';
    }
    $msgid =~ s'/'_#_'g;

    my $template = $count.'_'.$msgid.'_XXXXXX';
	my ($fh,$tmpfile);
    eval {
        ($fh,$tmpfile) = tempfile($template,
                                 DIR => $inbox,
	                			 SUFFIX => '');

        my $namelength = length($tmpfile);
        if ($namelength >= 238) {       # 255-16 (.eml.processing)
            die "File path to long";
        }
    };
    if ($@) {
        # File name to long?
        ($fh,$tmpfile) = tempfile($count.'_XXXXXXXXXXXX',
                                 DIR => $inbox,
	                			 SUFFIX => '');

        syslog('ERR',"Cannot create tempfile \"$template\". New filename: $tmpfile");
        print "Cannot create tempfile \"$template\". New filename: $tmpfile\n" if $VERBOSE;
    }
	if (defined $fh) {
        print $fh "X-REAL-RCPTTO: $real_to\r\n" if $real_to;

        if ($extraheader_value) {
            print $fh "$extraheader_name: $extraheader_value\r\n";
        }
        print $fh $email->as_string;

        if (! $fh->close) {
            croak "Cannot write tempfile $tmpfile: $!\n";
        }
		my $emlfile = $tmpfile.'.eml';
        chmod oct $filemode, $tmpfile;
		link $tmpfile, $emlfile;
        unlink $tmpfile;
		$pop->Delete($count) if $delete;
	}
    syswrite STDOUT,"." if $VERBOSE;
    $fetched++;
}
print "\n" if $VERBOSE;

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


#
### SUBS ###
#
sub version_exit
{
    print "benno-pop3 version $VERSION\n";
    exit 0;
}

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;
      print " $var => $val\n" if $DEBUG;
      $config{$var} = $val;
  }
  close CONF;
  return %config;
}


sub help_exit
{
    print "Aufruf: benno-pop3 [-D] [-c <file>] [-A <mode>] [-u <user>] [-p <pass>] [-i <inbox dir>] [-H <host>] [-n <num>] [-s] [-S]\n";
    print "  -D          print debug messages\n";
    print "  -c <file>   path to config file (format: param = value)\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 "  -R <userid> run as <userid> (default benno)\n";
    print "  -n <num>    fetch num mails per run (200)\n";
    print "  -d          delete mails on pop3 server\n";
    print "  -r <addr>   add address as X-REAL-RCPTTO header\n";
    print "  -s          ssl connect to pop3s (default port 995)\n";
    print "  -S          suppress ssl certificate verification\n";
    print "  -T <sec>    socket timeout in seconds (default: 60)\n";
    print "  -A <mode>   AUTH MODE: BEST (default) | PASS | APOP | CRAM-MD5\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";
    exit 1;
}


sub open_socket
{
    my ($host,$port,$ssl,$suppress_verify,$timeout) = @_;

    my $sock;
    if ($ssl) {
        $port = 995 unless $port;
        my $verify;
        if ($suppress_verify) {
            $verify->{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_NONE;
            $verify->{verify_hostname} = 0;
        }
        else {
            $verify->{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_PEER;
            $verify->{verify_hostname} = 1;
        }
        $sock  = IO::Socket::SSL->new(
            PeerHost => $host,
            PeerPort => $port,
            Timeout  => $timeout,
            SSL_verify_mode => $verify->{SSL_verify_mode},
            verify_hostname => $verify->{verify_hostname},
        ) or die $@;
    }
    else {
        $port = 110 unless $port;
        $sock  = IO::Socket::INET->new(
            PeerHost => $host,
            PeerPort => $port,
            Timeout  => $timeout,
        ) or die $@;
    }

    return $sock;
}


### Overwrite methods for fancier debugging.
sub Mail::POP3Client::_sockprint
{
  local ($, , $\);
  my $me = shift;
  my $s = $me->Socket();
  my $outline = "@_";
  if ($me->Debug) {
    if ($outline !~ /RETR\s/) {
        $me->{LWstate} = 'CMD';
    }
    if ($outline =~ /RETR\s/) {
        $me->{LWstate} = 'RETR_SW';
    }
    my $printline = $outline;
    $printline =~ s/^PASS\s.*$/PASS  ************/; 
    print STDERR '>>> '.$printline;
  }
  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]+//);

  if ($me->Debug) {
    if ($line =~ /^\.\r\n/) {
        if ($me->{LWstate} eq 'RETR') {
          $me->{LWstate} = 'CMD';
          print STDERR "<<<  (Done...)\n";
        }
    } elsif ($me->{LWstate} eq 'RETR_SW') {
        $me->{LWstate} = 'RETR';
        print STDERR "<<< ", $line;
    } elsif ($me->{LWstate} ne 'RETR') {
          print STDERR "<<< ", $line;
    }
  }
  $line =~ /^[\\+\\-](OK|ERR)/i && do {
    my $l = $line;
    chomp $l;
    push(@{$me->{tranlog}}, $l);
  };
  return $line;
}


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


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__

