#!/usr/bin/perl
#
#
#
use strict;
use Getopt::Std;
use Sys::Syslog;
use Benno;
no warnings 'utf8';

$main::VERSION = '2.10.2';

our(%opts);
getopts('dDehntvVc:E:H:i:p:P:R:s:u:w:',\%opts);

if ($opts{V}) { print "$main::VERSION\n"; exit; }

my %conf = Benno->config($opts{c}) if $opts{c};

my $delete          = $opts{d} || $conf{delete};
my $DEBUG           = $opts{D} || $conf{DEBUG};

my $emailregex      = $opts{E} || $conf{emailregex}   || '^.+\.eml$';
my $hostname        = $opts{H} || $conf{hostname};
my $inbox           = $opts{i} || $conf{inbox}        || '/srv/benno/inbox';
my $noverifycert    = $opts{n} || $conf{noverifycert};
my $password        = $opts{p} || $conf{password};
my $port            = $opts{P} || $conf{port}         || 21543;
my $runuser         = $opts{R} || $conf{runuser}      || 'benno';
my $username        = $opts{u} || $conf{username};
my $suffix          = $opts{s} || $conf{suffix};
my $testmode        = $opts{t} || $conf{testmode};
my $errfile         = $opts{e} || $conf{errorfile};
my $whitelist       = $opts{w} || $conf{whitelist};
my $verbose         = $opts{v};

my $path            = '/rest/inbox';

help_exit() if $opts{h};
help_exit('Hostname not set.') if ! $hostname;

Benno->run_as($runuser);
openlog('benno-send2rest','nowait,pid','mail');

my $uri = 'https://'.$hostname.':'.$port.$path;
print "Send to $uri\n" if $verbose;
my $RC = new Benno::REST::Client($uri,$username,$password,$noverifycert);

my $Whitelist = Whitelist->new($whitelist);

## READ FROM STDIN AND EXIT ####################################################
if ($inbox eq '--') {
    my $msg = "Read files from STDIN";
    syslog('INFO',$msg);
    print "$msg\n" if $verbose;

    eval {
        my $MD = Maildata->new('--');
        if ($Whitelist->check_addresses($MD->sender_list,$MD->recipient_list)) {
            syslog('INFO',"Email address(es) match whitelist");
            print "Email address(es) match whitelist\n";
        }
        else {
            syslog('INFO',"Skip upload: address(es) not in whitelist");
            print "Skip upload: address(es) not in whitelist\n" if $verbose;
            closelog;
            exit;
        }
        
        my $return = $RC->upload_mail($uri,$MD->content(),$DEBUG) unless $testmode;
        syslog('INFO',"Email archived: $return");
        print "Email archived: $return\n" if $verbose;
    };
    if ($@) {
        my $err = $@;
        syslog('ERR',"Cannot send file: $err");
        print "Cannot send file: $err";
    } 
    closelog;
    exit;
}
## /READ FROM STDIN AND EXIT ###################################################


## READ FILES FROM DIRECTORY ###################################################
my $msg = "Read files from \"$inbox\"";
$msg .= ' and delete after sent'    if $delete;

syslog('INFO',$msg);
print "$msg\n" if $verbose;

# read directory and process files
opendir my $dh, $inbox or die "Cannot read directory \"$inbox\": $!";
my $return;
foreach my $filename (readdir $dh) {
    next if $filename =~ /^\./;
    next if $filename !~ /$emailregex/;
    chomp $filename;
    my $file = "$inbox/$filename";
    $file =~ s!//!/!g;

    unless ($testmode) {
    eval {
        my $MD = Maildata->new($file);
        if ($Whitelist->check_addresses($MD->sender_list,$MD->recipient_list)) {
            syslog('INFO',"Email address(es) of $file in whitelist");
            print "Email address(es) of $file in whitelist\n" if $verbose;

            $return = $RC->upload_mail($uri,$MD->content(),$DEBUG);
            syslog('INFO',"Email \"$filename\" archived: $return");
            print "Email \"$filename\" archived: $return\n" if $verbose;
        }
        else {
            syslog('INFO',"Skip $file: address(es) not in whitelist");
            print "Skip $file: address(es) not in whitelist\n" if $verbose;
        }
        if ($suffix) {
            my $ufile = $file.".".$suffix;
            rename $file, $ufile or die "Cannot rename $file to $ufile: $!\n";
        }
    };
    if ($@) {
        my $err = $@;
        syslog('ERR',"Cannot send file \"$file\": $err");
        print "Cannot send file \"$file\": $err";
        if ($errfile) {
            my $errfile = $file.'.err';
            link $file, $errfile or warn "Cannot rename $filename to $errfile: $!\n";
            unlink $file;
        }
        # do not remove file
        next;
    }
    if ($delete) {
        unlink $file or print STDERR "Cannot delete $file: $!\n" and next;
        print "Delete $file from $inbox.\n" if $verbose;
    }
    }
}
closedir $dh;
closelog;
## /READ FILES FROM DIRECTORY ##################################################



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


### print help and exit
sub help_exit
{
    my $msg = shift;

    if ($msg) {
        print $msg,"\n\n";
    }

    print "Usage: $0 [-h] <-H <hostname> [<options>]\n";
    print "\n";
    print "     -c <configfile> configuration file\n";
    print "     -d              delete email after processing\n";
    print "     -H <hostname>   hostname of benno-import-rest server\n";
    print "     -P <port>       port (default: 21543)\n";
    print "\n";
    print "     -u <username>   username\n";
    print "     -p <password>   password\n";
    print "\n";
    print "     -e              rename upload file to .err on errors (default: leave unchanged)\n";
    print "     -s <extension>  append <extension> to uploaded file (default: leave unchanged)\n";
    print "     -i <importdir>  read eml-files from this dir\n";
    print "     -n              no verification of server certficate\n";
    print "     -t              test mode do not upload or delete mail\n";
    print "     -w <whitelist>  whitelist file (localpart\@domain or \@domain per line)\n";
    print "                     an empty whitelist matches always true\n";
    print "     -E <emailregex> email name regex (default: \"^.+\.eml\")\n";
    print "     -R <username>   run as user (default: benno)\n";
    print "\n";
    print "     -V              print version\n";
    print "     -v              verbose\n";
    print "     -h              print this help\n";
    print "\n";
    
    exit 1;
}


### EOP ###
1;

package Maildata;

sub new {
    my $class = shift;
    my ($filename) = @_;

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

    $self->_init();

    return $self;
}


sub content         { return $_[0]->{content};          }
sub sender_list     { return @{$_[0]->{sender}};        }
sub recipient_list  { return @{$_[0]->{recipients}};    }


sub _init
{
    my ($self) = @_;

    my $filename = $self->{filename};
    my $fh;
    my $content;
    if ($filename eq '--') {
        $fh = \*STDIN;
        $self->_read_file($fh);
    }
    else {
        open $fh, $filename or die "Error read $filename: $!\n";
        $self->_read_file($fh);
        close $fh;
    }
}


# no unfolding!
sub _read_file
{
    my ($self,$fh) = @_;

    my $in_header = 1;
    foreach my $line (<$fh>) {
        if ($in_header) {
            if ($line =~ /^X-REAL-MAILFROM:\s*?(\S.*?)\R/) {
                my $value = $1; $value =~ s/[<>]//g;
                chomp $value;
                push @{$self->{sender}}, $value;
            }
            if ($line =~ /^X-REAL-RCPTTO:\s*?(\S.*?)\R/) {
                my $value = $1; $value =~ s/[<>]//g;
                chomp $value;
                push @{$self->{recipients}}, $value;
            }
        }
        $self->{content} .= $line;
        if ($line =~ /^\R/) { $in_header = 0; }
    }

    if ($in_header) {
        # exit if no header found
        $ENV{DEBUG} eq 'maildata' &&  print STDERR "DATA READ: ",$self->{base_content},"\n";
        die "Maildata corrupt. Try environment variable DEBUG=maildata to see data\n";
    }
}


### EOP ###
1;

package Whitelist;

sub new {
    my $class = shift;
    my ($wlfile) = @_;

    my $self = [];
    bless $self, $class;

    if (-f $wlfile) {
        $self->_init($wlfile);
    }
    else {
        print STDERR "WARNING whitelist file does not exist: $wlfile\n" if $wlfile;
    }

    return $self;
}


sub _init
{
    my ($self,$wlfile) = @_;

    my @whitelist;
    open my $wl, '<', $wlfile or die "Cannot open whitelist file $wlfile: $!\n";
    foreach my $line (<$wl>) {
        chomp $line;
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next if $line =~ /^#/;
        next if $line !~ /\@/;

        print "(DEBUG) add entry $line to whitelist\n" if $DEBUG;
        push @{$self}, $line;
    }
    close $wl;

    return @whitelist;
}



### check if address(es) in whitelist
#           
# returns 1 if address or domain is in whitelist
# returns 1 if whitelist is empty (always true)
#    
sub check_addresses
{
    my ($self,@addresslist) = @_;

    # empty whitelist
    if (!@{$self}) {
        return 1;       # always true
    }

    my $iswl = 0;
    foreach my $mailaddr (@addresslist) {
        foreach my $wladdr (@{$self}) {
            next if $wladdr =~ /^#/;
            next if $wladdr =~ /^$/; 
            my $check_mailaddr = lc $mailaddr;
            my $check_wladdr   = lc $wladdr;
            if ($wladdr =~ /^\@/) {
                if ($check_mailaddr =~ qr/$check_wladdr$/) {   # domain name
                    $iswl = 1;
                    print "(DEBUG) whitelist match: $check_mailaddr -> $check_wladdr\n" if $DEBUG;
                }
            }
            else {
                if ($check_mailaddr =~ qr/^$check_wladdr$/) {   # email address
                    $iswl = 1;
                    print "(DEBUG) whitelist match: $check_mailaddr -> $check_wladdr\n" if $DEBUG;
                }
            }
        }
    }

    return $iswl;
}


### EOP ###
1;

package Benno::REST::Client;
use HTTP::Tiny;
use MIME::Base64;
use JSON;

sub new {
    my $class = shift;
    my ($uri,$username,$password,$noverifycert) = @_;


    my $UA;
    if ($noverifycert) {
        $UA = HTTP::Tiny->new(verify_SSL => 0);
    }
    else {
        $UA = HTTP::Tiny->new;
    }

    my $authstring = encode_base64($username.':'.$password);    # encode_base64 adds newline
    chomp $authstring;

    my $self = {
        uri         => $uri,
        UA          => $UA,
        authstring  => $authstring,
    };
    bless $self, $class;


    return $self;
}


sub upload_mail
{
    my ($self,$uri,$content,$DEBUG) = @_;

    my $response,
    my $options;
    my $headers;

    if ($uri !~ /^\@/) {    # uri auth overwrites username a. password
        $headers->{Authorization}  = 'Basic '.$self->{authstring} if $self->{authstring};
    }

    $options->{headers} = $headers;
    $options->{content} = $content;

    $response = $self->{UA}->request('PUT', $uri, $options);

    my $return;
    if ($response->{success}) {
        $return = $response->{content};
        $return =~ s/\r//g;
        if ($DEBUG) {
            print "---- RETURN DATA ----\n";
            print "$return\n";
            print "---- RETURN DATA ----\n";
        }
        if ($return =~ /^OK\s(.+?)$/) {
            return $1;
        }
        else {
            die "Error decoding return value: $return";
        }
    }
    else {
        die 'ERROR '.$response->{status}.' '.$response->{reason}."\n";
    }
}



### 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) {
        use Sys::Syslog;
        openlog('benno-send2rest','nowait,pid','mail');
        # cannot lock __DATA__ "file"
        print STDERR "An instance of $0 is already running.\n" if -t;
        syslog('ERR',"An instance of $0 is already running.\n");
        exit 1;
    }
}

### EOP ###
1;


__END__

