#!/usr/bin/perl
#
# Benno MailArchiv
#
# Copyright 2018-2021 LWsystems GmbH
#
# http://www.lw-systems.de/
#
# All rights reserved.
#
# The source code of this program is made available
# under the terms of the GNU Affero General Public License version 3
# (GNU AGPL V3) as published by the Free Software Foundation.
#
# Binary versions of this program provided by Univention to you as
# well as other copyrighted, protected or trademarked materials like
# Logos, graphics, fonts, specific documentations and configurations,
# cryptographic keys etc. are subject to a license agreement between
# you and Univention and not subject to the GNU AGPL V3.
#
# In the case you use this program under the terms of the GNU AGPL V3,
# the program is provided in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public
# License with the Debian GNU/Linux or Univention distribution in file
# /usr/share/common-licenses/AGPL-3; if not, see
# <http://www.gnu.org/licenses/>.

use strict;
use Fcntl ':flock';
use Getopt::Std;
use Sys::Syslog;
use IO::Socket;
use IO::Socket::SSL;
use Mail::IMAPClient;
use File::Temp qw/tempfile/;
use Carp;
use Date::Parse;
use DBI;
use MIME::Base64;
my $VERSION = '3.0.3';

my %opts;
getopts('DSCdfhlMsTUvVA:c:e:F:H:i:I:o:u:p:r:R:P:X:x:',\%opts);


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

STDOUT->autoflush(1);  # autoflush needed while writing to pipe
STDERR->autoflush(1);  #

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

$conf{list_folders} = $opts{l};
$conf{user}         = $opts{u}|| $conf{user};
$conf{authuser}     = $opts{A}|| $conf{authuser};
$conf{pass}         = $opts{p}|| $conf{pass};
$conf{count}        = $opts{C}|| $conf{count};
$conf{delete}       = $opts{d}|| $conf{delete};         # delete mail on server
$conf{extension}    = $opts{e}|| $conf{extension} || 'eml';
$conf{user}         = $opts{u}|| $conf{user};
$conf{with_folders} = $opts{f}|| $conf{with_folders};
$conf{folder}       = $opts{F}|| $conf{folder};
$conf{ssl}          = $opts{s}|| $conf{ssl};
$conf{inbox}        = $opts{i}|| $conf{inbox} || '/srv/benno/inbox'; # load mails to inbox directory 
$conf{host}         = $opts{H}|| $conf{host} || 'localhost';
$conf{port_arg}     = $opts{P}|| $conf{port_arg};
$conf{subfolders}   = $opts{S}|| $conf{subfolders};    # only subfolders
$conf{version}      = $opts{V}|| $conf{version};
$conf{real_to}      = $opts{r}|| $conf{real_to};
$conf{older_ts}     = $opts{o}|| $conf{older_ts};
$conf{tag_seen}     = $opts{T}|| $conf{tag_seen};
$conf{unseen}       = $opts{U}|| $conf{unseen};
$conf{ignorelist}   = $opts{I}|| $conf{ignorelist};
$conf{runmulti}     = $opts{M}|| $conf{runmulti};
$conf{runuser}      = $opts{R}|| $conf{runuser}   || 'benno';
$conf{extraheader_name}  = $opts{X} || $conf{extraheader_name} || 'X-BENNO-GW';
$conf{extraheader_value} = $opts{x} || $conf{extraheader_value};

main::lock() unless $conf{runmulti};

help_exit() if not ($conf{user} and $conf{pass});

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

LWs::RunAs->import($conf{runuser});

$conf{with_folders} = 1 if $conf{subfolders};
openlog('benno-imapimport','nowait,pid','mail');

local $SIG{__WARN__} = sub {
    syslog('WARNING',"WARN: $_[0]");
};

my @ignorelist = splitlist($conf{ignorelist});

my $imap = imap_connect(%conf);

my $sepChar = $imap->separator();

if ($imap->Authenticated()) {
    print "Login for user $conf{user} successful.\n" if -t;
}

# list folders and exit
if ($conf{list_folders}) {
    print "Folder list for user \"$conf{user}\":\n";
    foreach my $foldername ($imap->folders) {
        next unless $imap->selectable($foldername);
        print "  $foldername\n";
    }
    exit 0;
}

if ($conf{older_ts} && $verbose) {
    print "Fetch messages older: ".epoch2localtime($conf{older_ts}).".\n" if -t;
}

my $num = 0;
my $mails_loaded = 0;
my $error;
eval {
if (!$conf{subfolders}) {
    my $folder = get_serverfoldername($imap,$conf{folder});
    if (!$imap->select($folder)) {
        my $error = $imap->LastError;
        die "Error select $conf{user}/$folder: $error\n";
    }
    if ($verbose) {
        print "** Fetch $folder";
        print ": ".$imap->message_count." messages" if $conf{count};
        print "\n";
    }
    eval {
        ($num,$error) = save_mails($imap,%conf);
    };
    if ($error) {
        print STDERR "Error in $conf{user}/$folder at $num: $error\n" if -t;
        syslog('ERR',"Error in $conf{user}/$folder at $num: $error\n");
    }
    else {
        print "  $num emails exported from $folder.\n" if -t;
        syslog('INFO',"$num emails exported from $folder.");
    }
    $mails_loaded += $num;

    # Exchange closed cconnection if 0 mails but returns "is connected"
    if (!$imap->close()) {  # deselect folder
        my $error = $imap->LastError;
        syslog('WARNING',"Cannot close $conf{user}/INBX at $num: $error\n");
        print STDERR "Cannot close $conf{user}/INBOX: $error\n" if -t;
        $imap = imap_connect(%conf);
    }
}
};
if ($@) {
    my $error = $@;
    syslog('ERR',"ERROR: $error");
    die "Error loading INBOX: $error\n" if -t;
}

eval {
if ($conf{with_folders}) {
    print "** Subfolders:\n" if $verbose;
    my @folders = $imap->folders() or die "Cannot list folders: $@\n";
    foreach my $subfolder (@folders) {
        #$subfolder = quotemeta($subfolder); # FS#963 >> FS#977
        #$subfolder =~ s/\s+$//;            # FS#823
        next if ($subfolder =~ /^INBOX$/);
        next if grep /^$subfolder$/, @ignorelist;
        next unless $imap->selectable($subfolder);

        if (!$imap->select($subfolder)) {
            my $error = $imap->LastError;
            if ($error =~ /^\S+\s+NO SELECT/) {
                print "* NO SELECT flag on $conf{user}/$subfolder\n" if $verbose;
                next;
            }
            print STDERR "Error select $conf{user}/$subfolder: $error\n";
            next;
        }
        if ($verbose) {
            print "* Fetch $subfolder";
            print ': ',$imap->message_count,' messages' if $conf{count};
            print "\n";
        }

        my ($num,$error) = save_mails($imap,%conf);
        if ($error) {
            print "Error in subfolder $conf{user}/$subfolder at $num: $error\n" if -t;
            syslog('ERR',"Error in subfolder $conf{user}/$subfolder at $num: $error\n");
            sleep 5;
            if ($imap->IsUnconnected) {
                $imap = imap_connect(%conf);
            }
            next;
        }
        else {
            print "  $num emails exported from $subfolder.\n" if -t;
            syslog('INFO',"$num emails exported from $subfolder.");
        }

        $mails_loaded += $num;
        # Exchange closed cconnection if 0 mails but returns "is connected"
        if (!$imap->close()) {  # deselect folder
            my $error = $imap->LastError;
            syslog('WARNING',"Cannot close $conf{user}/$subfolder at $num: $error\n");
            print STDERR "Cannot close $conf{user}/$subfolder: $error\n" if -t;
            $imap = imap_connect(%conf);
        }
    }
}
};
if ($@) {
    my $error = $@;
    syslog('ERR',"ERROR: $error");
    die "Error loading subfolder $error\n" if -t;
}

$imap->logout() or print STDERR "Could not logout from \"$conf{user}\": $@\n" if -t;

print "$mails_loaded emails exported for user $conf{user}\n" if $verbose;
closelog();


### SUBS ###

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


### splitlist
sub splitlist
{
    my ($liststring) = $@;

    my @ignorelist;
    foreach my $entry (split /(?<!\\),/, $conf{ignorelist}) {
        $entry =~ s/\\,/,/g;
        push @ignorelist, $entry;
    }

    return @ignorelist;
}


### imap_connect
sub imap_connect
{
    my %conf = @_;

    # port_arg with predence
    my $port = $conf{port_arg} ne ''  ? $conf{port_arg}
             : $conf{ssl}             ? 993
             :                          143
             ;

    my $socket = $conf{ssl} ? IO::Socket::SSL->new()
                            : IO::Socket::INET->new();

    $socket->configure({
            Proto           => 'tcp',
            PeerAddr        => $conf{host},
            PeerPort        => $port,
            SSL_verify_mode => 0x00,
            Timeout         => 3600,
        }) or die "Cannot connect to $conf{host}:$conf{port}\n";

    if ($verbose || $DEBUG) {
        print 'Connect to '.$socket->peerhost.':'.$socket->peerport."\n";
    }

    my $imap = Mail::IMAPClient->new(
            Socket => $socket,
            DEBUG  => $DEBUG,
            )
        or die "Cannot connect to $conf{host} as $conf{user}: $@";;
#    $imap->Debug($DEBUG) if $DEBUG;

    $imap->User($conf{user});
    $imap->Password($conf{pass});
    if ($conf{authuser}) {
        $imap->Authmechanism('PLAIN');
        $imap->Authuser($conf{authuser});
        $imap->Authcallback(\&imap_authcallback) if $conf{authuser};
        $imap->authenticate($imap->Authmechanism,$imap->Authcallback);
    }

    $imap->login();

    if (!$imap->IsAuthenticated()) {
        die "Could not login: ",$imap->LastError,"\n";
    }

    $imap->Reconnectretry(1);
    $imap->Uid(1);

    # seen flag:      | set          | don't set    |
    $conf{tag_seen} ? $imap->Peek(0) : $imap->Peek(1);
    $imap->Uid(1);      # message UID numbers

    return $imap;
}


sub imap_authcallback {
        my ($code,$imap) = @_;
        my $string = sprintf("%s\x00%s\x00%s", $imap->User,
                            $imap->Authuser, $imap->Password);
        return encode_base64("$string", "");
}



### get_serverfoldername
sub get_serverfoldername
{
    my ($imap,$folder) = @_;

    my ($p_pfx,$p_sep);
    if ($folder) {
        # fetch personal namespace
        my $prefix= $imap->namespace;
        # $prefix = [
        #             [   
        #               [$user_pfx,$user_sep],
        #               ... 
        #             ],  # or undef
        #             [   
        #               [ $shared_pfx,$shared_sep],
        #               ... 
        #             ],  # or undef
        #             [   
        #               [ $public_pfx, $public_sep],
        #               ...
        #             ], # or undef
        #           ]
        $p_pfx = $prefix->[0]->[0]->[0];
        $p_sep = $prefix->[0]->[0]->[1];
        if ($p_pfx) {
            # Prefix always with trailing / (FS#859)
            $folder = $p_pfx.$folder;
        }
    }
    else {
        $folder = 'INBOX';
    }

    return $folder;
}


### save_mails
sub save_mails
{
    my ($imap,%conf) = @_;

    my $inbox       = $conf{inbox};
    my $delete      = $conf{delete};
    my $real_to     = $conf{real_to};
    my $older_ts    = $conf{older_ts};
    my $extension   = $conf{extension}; $extension =~ s/\.\././;
    my $num = 0;

    my @msglist;
    my $extraheader;
    if ($conf{extraheader_value}) {
        $extraheader = "$conf{extraheader_name}: $conf{extraheader_value}";
    }
    
    if ($conf{unseen}) { @msglist = $imap->unseen();   }
    else               { @msglist = $imap->messages(); }

    if ($#msglist >= 0 &! $msglist[0]) {    # 1 empty element / () returns -1
        return($num);
    }

    my ($from_ts,$to_ts);
    my $ts_reverse = 0;

    if ($older_ts =~ /^-(\d+)$/) {      # reverse order
        $from_ts = $1;
        $to_ts   = undef;
    }
    else {                              # normal order
        $to_ts   = $older_ts;
        $from_ts = undef;
    }
    if ($older_ts =~ /^(\d+):(\d+)$/) { # slice
        $from_ts = $1;
        $to_ts   = $2;
    }

    foreach my $msg_id (@msglist) {
        if (!$msg_id) {
            syslog('WARNING',"WARN: Empty message id.");
            print STDERR "Empty message id." if -t;
            next;
        }
        if ($older_ts) {
            my $peekval = $imap->Peek();
            $imap->Peek(1);
            my $mail_date = $imap->date($msg_id);
            $imap->Peek($peekval);

            my $messageDateTS = str2time($mail_date);
            next if ($to_ts     && ($messageDateTS  > $to_ts));
            next if ($from_ts   && ($messageDateTS  < $from_ts));
        }

        syslog('INFO',"Load mail $num [$msg_id].") if $verbose;
        print "  Load mail $num [$msg_id].\n" if $verbose;
        eval {
            write_tmpfile($imap,$msg_id,$inbox,$real_to,$extraheader,$extension);
            if ($delete) {
                if (!$imap->delete_message($msg_id)) {
                    syslog('ERR',"Cannot delete message $msg_id: $@");
                    die "Cannot delete message $msg_id: $@\n";
                }
            }
        };
        if ($@) {
            return($num,$@);
        }

        $num++;
    }

    return($num);
}


### write_tmpfile
sub write_tmpfile
{
    my ($imap,$msg_id,$inbox,$real_to,$extraheader,$extension) = @_;
    my $error = 0;

    my $pre_name = $msg_id;
    $pre_name = $real_to.'_'.$msg_id if $real_to;

    my ($fh,$tmpfile) = tempfile($pre_name.'_XXXXXXXXXXXX',
                                 DIR => $inbox,
                                 SUFFIX => '');

    if (defined $fh) {
        print $fh "X-REAL-RCPTTO: $real_to\r\n" if $real_to;
        print $fh "$extraheader\r\n" if $extraheader;
        if (!$imap->message_to_file($fh,$msg_id)) {
            $error = $imap->LastError;
            syslog('ERR',"Error fetching $msg_id from $inbox: $error");
            die "Could not fetch $msg_id to $tmpfile: $error\n";
        }
        if (! $fh->close) { die "Cannot write $msg_id to $tmpfile: $!\n"; }
        
        my $emlfile = $tmpfile.'.'.$extension;
        link $tmpfile, $emlfile;
        unlink $tmpfile;
    }
    else {
        die "Cannot create $tmpfile: $!\n";
    }
}


### epoch2localtime
sub epoch2localtime
{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
                                                    localtime($conf{older_ts});
    #                         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);

    return "$mday.$mon.$year $hour:$min:$sec";
}

### lock
#   allow one instance of this program running
sub lock {
    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-imapimport','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;
    }
}


### help_exit
sub help_exit
{
    print "Aufruf: benno-imapimport [-D] [-c <configfile>] -u <user> -p <pass> [-H <host>] [-P <port>] [-s] [-v]\n";
    print "        [-c <config>] [-A <authuser>] [-F <folder>] [-f][-S] [-i <inbox_dir>] [-d]\n";
    print "        [-r <address>] [-o <epochtime> ] [-:] [-v] [-V]\n";
    print "\n";
    print "  -c <configfile>   config file\n";
    print "  -u <username>     imap username\n";
    print "  -p <password>     imap password\n";
    print "  -H <host>         imap host (default localhost)\n";
    print "  -P <port>         imap port (default 143)\n";
    print "  -l                list folders and exit.\n";
    print "  -F <folder>       select folder <folder> after login (default INBOX)\n";
    print "  -I \"<ignorelist>\" ignore folder names (list separated by , escaped by \\)\n";
    print "  -i <inbox_dir>    save mails in <inbox_dir> (/srv/benno/inbox)\n";
    print "  -e <extension>    extenson of saved files  (default .eml)\n";
    print "  -f                with subfolders\n";
    print "  -S                only subfolders (implies -f)\n";
    print "  -s                imaps (default port 993)\n";
    print "  -C                count messages in folder\n";
    print "  -d                delete mails on server after stored in inbox\n";
    print "  -o <epochtime>    import mails older epoch timestamp (newer: -<ts>, between: <time>:<time> )\n";
    print "  -M                allow multi instances running\n";
    print "  -r <address>      add address as X-REAL-RCPTTO header\n";
    print "  -A <authuser>     authuser for IMAP AUTHENTICATE\n";
    print "  -R <runuser>      run as user <runuser> (default benno)\n";
    print "  -v                verbose\n";
    print "  -T                tag read mails as seen (default: left unseen)\n";
    print "  -U                read only unseen mails from server (default: all)\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                print version and exit\n";

    exit 1;
}

sub version_exit
{
    my $version = shift;
    print "$0 $version\n";
    exit 0;
}

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

