#!/usr/bin/perl
#
#
use Getopt::Std;
use Sys::Syslog;
use IO::Socket::INET;
use Benno::Config;

my %opts;
getopts('hdvVc:C:H:i:p:P:',\%opts);

my $configfile  = $opts{c}      || '/etc/benno/benno.xml';
my $container   = $opts{C};     # all if not set
my $delete_repo = $opts{d};
my $host        = $opts{H}      || 'localhost';
my $importlist  = $opts{i};
my $port        = $opts{P}      || 2555;
my $pwdfile     = $opts{p}      || '/etc/benno/archive.secret';
$verbose        = $ENV{DEBUG}   || $opts{v};;

my $VERSION = '2.10.0';

$opts{V} && print "benno-archive-delete $VERSION\n" and exit 0;

openlog('benno-archive-delete','nowait,pid','mail');

my $passwd;
eval {
    $passwd = read_pwdfile($pwdfile);
};
if ($@){
    print STDERR "$@\n";
    help_exit();
}

my $BMG = new Benno::Management($host,$port,$passwd,$verbose);

if ($delete_repo) {
    del_repo($BMG,$configfile,$container);
}
else {
    del_index($BMG,$importlist);
}

closelog;



### SUBS ###

### get_containerlist
sub get_containerlist
{
    my ($configfile,$container) = @_;
    my @containerlist;

    my $BennoXML = new Benno::Config($configfile);
    foreach my $Container ($BennoXML->get_containers) {
        if ($container && ($Container->id eq $container)) {
            return qw($Container);
        }

        push @containerlist, $Container;
    }

    return @containerlist;
}


### delete_bennoid
sub delete_bennoid
{
    my ($rpath,$bennoid) = @_;
    # TODO: dynamic path on subdirs/dirlength

    my ($box,$p1,$p2,$p3,$p4) = $bennoid =~ /^(.+?):(..)(..)(..)(.+)$/;
    my $filepath = "$rpath/$box/$p1/$p2/$p3/$p4";
    $filepath .= '.gz';

    unlink $filepath or die "Cannot delete mailfile $filepath: $!\n";
    # remove empty directories
    rmdir "$rpath/$box/$p1/$p2/$p3/" or return;
    rmdir "$rpath/$box/$p1/$p2/" or return;
    rmdir "$rpath/$box/$p1/" or return;
}


### del_index
sub del_index
{
    my ($BMG,$importlist) = @_;
    my $verbose = $BMG->{verbose};

    my $ih;
    if ($importlist) {
        open $ih, $importlist or die "Cannot open import file $importlist: $!\n";
    }
    else {
        -t STDIN && help_exit();
        $ih = \*STDIN;
    }

    while($line = <$ih>) {
        $line =~ s/[\r\n]//g;
        my ($container,$bennoid);
        if (! (($container,$bennoid) = $line =~ /^(.+?);(\S+?)$/)) {
            syslog('ERR',"Input format error: $line\n");
            print STDERR "Input format error: $line\n";
            next;
        }
        eval {
            print "DELETE $container $bennoid\n" if ($verbose >= 2);
            my $delmsg = $BMG->delindex($container,$bennoid);
            syslog('INFO',"$delmsg");
            print "$delmsg\n" if $verbose;
        };
        if ($@) {
            my $err = $@;
            syslog('ERR',"$err");
            print STDERR "$err" if -t STDERR;
        }
    }
    close $ih if $importlist;

    return;
}



### get_delfiles
sub get_delfiles
{
    my ($delfilepath) = @_;

    my @delfiles;

    opendir(my $dirh, $delfilepath) or die "Cannot open directory $delfilepath: $!";
    while (my $entry = readdir($dirh)) {
        next unless $entry =~ /.\d+\.remove/;
        push @delfiles, "$delfilepath/$entry";
    }
    closedir $dirh;

    return @delfiles;
}


### del_repo
sub del_repo
{
    my ($BMG,$configfile,$container) = @_;
    my $verbose = $BMG->{verbose};

    my @containers = get_containerlist($configfile,$container);
    foreach my $Container (@containers) {
        my $container = $Container->id;
        my $rpath = $Container->repopath.'/repodata/remove';
        print "Process $rpath\n" if $verbose >= 2;

        my $filecount = 0;
        foreach my $delfile (get_delfiles($rpath)) {
            my $rmdelfile = 2;      # 0:do nothing, 1:rename, 2:delete
            $filecount = 1;

            print "Process listfile $delfile\n" if $verbose >= 3;
            open my $fileh, $delfile or die "Cannot open delfile $delfile: $!";
            my $filelist = {};
            while(my $bennoid = <$fileh>) {
                chomp $bennoid;
                if (exists $filelist->{$bennoid}) {     # multiple entries in file
                    syslog('WARNING',"Found multiple $container/$bennoid entries.");
                    print STDERR "Found multiple $container/$bennoid entries.\n" if $verbose;
                    next;
                }
                $filelist->{$bennoid} = 1;
                eval {
                    my $delmsg = "PURGE $container $bennoid";
                    syslog('INFO',"$delmsg");
                    print "$delmsg\n" if $verbose >= 2;

                    $BMG->logdelete($container,$bennoid);
                    eval {
                        delete_bennoid($Container->repopath,$bennoid);
                    };
                    if ($@) {
                        $rmdelfile = 1;
                    }
                };
                if ($@) {
                    my $err = $@;
                    $rmdelfile = 0;
                    syslog('ERR',"$container/$bennoid: $err");
                    print STDERR "$container/: $err";
                }
            }
            close $fileh;

            if ($rmdelfile == 2) {
                unlink $delfile or warn "Cannot remove $delfile: $!\n";
            }
            elsif ($rmdelfile == 1) {
                (my $delnew = $delfile) =~ s/\.remove/.error/;
                syslog('ERR',"WARN Cannot remove all emails from \"$delfile\"");
                print STDERR "WARN Cannot remove all emails from \"$delfile\"\n";
                rename $delfile, $delnew;
            }
        }
        if (!$filecount) {
            print "No emails prepared for deletion in $container\n" if $verbose;
        }
    }
}


### read_pwdfile
sub read_pwdfile
{
    my $pwdfile = shift;

    open my $ph, $pwdfile or die "Cannot open password file $pwdfile: $!\n";
    my $passwd = <$ph>;
    close $ph;
    $passwd =~ s/[\r\n]//g;

    return $passwd;
}

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

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

    print "Usage: $0 [-h] [-c <benno.xml>] <[-i <listfile> | STDIN] | -d>\n";
    print "\n";
    print "   delete from index and mark to remove from repo:\n";
    print "     -i <listfile>       File with list of Benno IDs to delete or STDIN\n";
    print "                         Format: <containerid>;<bennoid>\n";
    print "\n";
    print "   delete marked emails from repo\n";
    print "     -d                  Delete entry from repo and log in journal\n";
    print "     -C <container>      Container for full delete (default all containers)\n";
    print "\n";
    print "     -c <configfile>     Benno config file (default: /etc/benno/benno.xml)\n";
    print "     -p <pwfile>         password file (default: /etc/benno/archive.secret\n";
    print "     -v                  verbose\n";
    print "     -V                  print version\n";
    print "     -h                  print this help\n";
    print "\n";

    exit 1;
}

### EOP ###
1;

package Benno::Management;

sub new {
    my $class = shift;
    my ($host,$port,$pass,$verbose) = @_;
    my $self = {
        host        => $host,
        port        => $port,
        password    => $pass,
        verbose     => $verbose,
    };
    bless $self, $class;
    # check connect
    $self->connect()->shutdown(SHUT_RDWR);

    return $self;
}


sub passwd { return $_[0]->{password}; }


sub delindex
{
    my ($self,$container,$bennoid) = @_;
    chomp $bennoid;

    my $delcmd = "delindex\n";
    $delcmd .= $self->passwd."\n";
    $delcmd .= "$bennoid\n$container\n";

    return $self->send($delcmd);
}


sub logdelete
{
    my ($self,$container,$bennoid) = @_;
    chomp $bennoid;

    my $delcmd = "logdelete\n";
    $delcmd .= $self->passwd."\n";
    $delcmd .= "$bennoid\n$container\n";

    return $self->send($delcmd);
}



sub send
{
    my ($self,$data) = @_;

    print "Send to archiver: $data" if $self->{verbose} >= 4;
    my $socket = $self->connect();
    my $sent = $socket->send($data);
    if (!$sent) {
        $socket->shutdown(SHUT_RDWR);
        die "ERROR Cannot send data to $host:$port: $!\n";
    }
    my $response = '';
    $sent = $socket->recv($response, 1024);
    $socket->shutdown(SHUT_RDWR);
    chomp $response;

    print "  Response: $response\n" if $self->{verbose} >= 4;
    if ($response !~ /^(OK|WARN)/) {
        die "$response\n";
    }

    return $response;
}


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

    my $socket = new IO::Socket::INET (
        PeerHost => $self->{host},
        PeerPort => $self->{port},
        Proto => 'tcp',
    ) or die "Cannot connect to $host:$port: $!\n";
    $socket->autoflush(1);

    return $socket;
}


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

