#!/usr/bin/perl
#
#
use strict;
use Getopt::Std;
use Data::Dumper;
use LWP::Protocol::https;   # ensure using https!
use Net::Amazon::S3;
use Digest::SHA qw(sha256);
use Benno::Config;
use Benno::Boxstate;

my $VERSION = '2.8.16';

my %opts;
getopts('DdFhlqtvb:B:c:C:d:i:I:k:P:',\%opts);

$opts{h} and help_exit();

my $conf;
$conf->{boxstate}       = $opts{B} if $opts{B};
$conf->{boxid}          = $opts{b} if $opts{b};
$conf->{container}      = $opts{C} if $opts{C};
$conf->{del_key}        = $opts{d} if $opts{d};
$conf->{del_keypfx}     = $opts{D} if $opts{D};
$conf->{keyid}          = $opts{i} if $opts{i};
$conf->{inboxdir}       = $opts{I} if $opts{I};
$conf->{keylist}        = $opts{k} if $opts{k};
$conf->{list}           = $opts{l} if $opts{l};
$conf->{quiet}          = $opts{q} if $opts{q};
$conf->{test}           = $opts{t};
$conf->{verbose}        = $opts{v} if $opts{v};
$conf->{bennoxml}       = $opts{c} || '/etc/benno/benno.xml';
$conf->{DEBUG}          = $ENV{DEBUG};

$conf->{container} or $conf->{boxstate} or
    help_exit('Need container id (-C <id>) or boxstate file (-B <file>)');

if ($conf->{container}) {
    my $BennoXML = new Benno::Config($conf->{bennoxml}) if $conf->{bennoxml};
    $conf->{BennoXML} = $BennoXML;

    my $Container = $BennoXML->get_container($conf->{container});
    $conf->{boxstate} = $Container->get_config('repopath').'/boxstate.xml';
}

my $Boxstate = new Benno::Boxstate($conf->{boxstate});
$conf->{DEBUG} && print "DEBUG Boxstate:\n",Dumper([$Boxstate]);
my $Box = $Boxstate->get_open();
$conf->{authkeyid}  = $Box->get_config('authKeyId');
$conf->{authsecret} = $Box->get_config('authKey');
$conf->{endpoint}   = $Box->get_config('endpoint');
$conf->{bucket}     = $Box->get_config('bucket');
$conf->{pathprefix} = $Box->get_config('bennoPath');
$conf->{filesuffix} = '.gz' if $Box->get_config('compression') eq 'gzip';

$conf->{DEBUG} && print "DEBUG config:\n",Dumper([$conf]);

$conf->{_S3} = new S3($conf);

$conf->{keylist}                && check_keylist($conf);
$conf->{del_key}                && del_key($conf); 
$conf->{del_keypfx}             && del_keyprefix($conf); 
$conf->{bucket_list}            && print_buckets($conf); 
$conf->{bucket}                 && print_bucketfiles($conf); 

print STDERR "Missing command argument.\n";
help_exit();


### SUBS #######################################################################

### del_key
sub del_key
{
    my ($conf,$keyid) = @_;
    my $S3 = $conf->{_S3};

    $keyid = $conf->{keyid} unless $keyid;
    my $bucket = $S3->bucket($conf->{bucket});
    $bucket->delete_key($keyid) or die $S3->err . ": " . $S3->errstr;

    exit 0;
}


### del_keyprefix
sub del_keyprefix
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};

    my $prefix = 'NOPREFIX';
    $prefix = $conf->{prefix} or die "ERROR. Prefix not given.\n"; 
    if ($prefix !~ /benno\/data\/repo\/\S{4,}/) {
        print "WARN Delete prefix starts not with \"benno/data/repo/..../\"\n";
        print "Override with switch \"-F\"\n" unless $conf->{force_pfx};
        exit 1 unless $conf->{force_pfx};
    }

    my $bucket = $S3->bucket($conf->{bucket});
    my $response = _get_objeclist($S3,$bucket,$prefix);

    my $keycount = @{$response->{keys}};
    print "Delete $keycount objects from \"[$conf->{bucket}]$prefix\"\n";

    my $stats = new Stats;
    foreach my $keyobj (@{$response->{keys}}) {
        $stats->add($keyobj);
        print "Delete #".$stats->get_count." [$conf->{bucket}]$keyobj->{key}\n" if $conf->{verbose};
        $bucket->delete_key($keyobj->{key})
                or die $S3->err . ": " . $S3->errstr;
    }

    unless ($conf->{quiet}) {
        print $stats->get_size, " in ",$stats->get_count," files deleted.\n";
    }

    exit 0;
}


### print_buckets
sub print_buckets
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};
    foreach my $bucket (@{$S3->buckets->{buckets}}) {
        print $bucket->bucket,"\n";
    }

    exit 0;
}


### print_bucketfiles
sub print_bucketfiles
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};

    my $bucket = $S3->bucket($conf->{bucket});
    my $response = _get_objeclist($S3,$bucket,$conf->{prefix});

    my $stats = new Stats();
    foreach my $key (@{$response->{keys}}) {
        $stats->add($key);

        print "$key->{key}\n";
        print "  Size:     $key->{size} bytes\n" unless ($conf->{quiet});
        print "  Modified: $key->{last_modified}\n" if ($conf->{verbose});
    }

    print "\n";

    unless ($conf->{quiet}) {
        print $stats->get_size, " in ",$stats->get_count," files.\n";
    }

    exit 0;
}



### check_keylist
sub check_keylist
{
    my ($conf) = @_;
    my $S3 = $conf->{_S3};

    my $Bucket = $S3->bucket($conf->{bucket});

    my $boxkeys = get_idlist($conf->{keylist}) if $conf->{keylist};
    foreach my $boxid (keys %{$boxkeys}) {
        foreach my $subid (@{$boxkeys->{$boxid}}) {
            my $keyid = $conf->{pathprefix}.'/'.$boxid.':'.$subid.$conf->{filesuffix};
            if (my $head = $Bucket->head_key($keyid)) {
                print "OK $keyid (",$head->{content_length},")\n";

                if ($conf->{verbose}) {
                    print "  Last modified: ",$head->{'last-modified'},"\n";
                    print "  Content type:  ",$head->{'content-type'},"\n";
                }
            }
            else {
                print "NA $keyid (ERROR)\n";
            }
        }
    }

    exit 0;
}

### help_exit
sub help_exit
{
    my ($msg) = @_;
    print "$msg\n\n" if $msg;
    print "Usage: benno-s3-admin [-D] [-c <configfile>] -C <continer>\n";
    print "  -c <bennoxml>      config file (/etc/benno/benno.xml)\n";
    print "\n";
    print "  -C <container>     container id\n";
    print "  -B <boxstate>      boxstate file, overrides benno.xml and container\n";
    print "  -l                 print container list\n";
    print "  -k <key|list>      key or keylist\n";
    print "  -I <inboxdir>      inbox directory (default from benno.xml)\n";
    print "  -q                 quiet mode\n";
    print "  -F                 force short prefix\n";
    print "  -v                 verbose mode\n";
    print "\n";
    print " List operations\n";
    print "  -C <container> <args>\n";
    print "    ... -P <prefix>              list objects with prefix\n";
    print "\n";
    print "   Bucket operations\n";
    print "     ... -i <keyid>  -d          delete key with given id\n";
    print "     ... -P <prefix> -D          delete keys with given prefix\n";
    print "\n";
    print "\n";
    exit 1;
}


sub get_idlist
{
    my ($listfile) = @_;
    my $boxlist = {};
    my $idlist;

    open my $listfh, $listfile or die "Cannot open $listfile: $!\n";
    foreach my $line (<$listfh>) {
        next if $line =~ /^#/;
        $line =~ s/\R//g;
        # 2022:980A9994505E8B241C6A7A3B7DDE08D2FD26246B3527F62B8FF4D31036744C4500
        my ($box,$bennoid) = split /:/, $line;
#        $boxlist->{$box} = [] unless (exists ($boxlist->{$box});
        push @{$boxlist->{$box}}, $bennoid;
    }
    close $listfh;

    return $boxlist;
}


sub _get_objeclist
{
    my ($S3,$Bucket,$prefix) = @_;
    my $response = $Bucket->list_all({ prefix => $prefix})
            or die $S3->err . ": " . $S3->errstr;

    return $response;
}



### EOP ###
1;


package Stats;

sub new
{
    my $class = shift;
    my $self = {
        counter => 0,
        size    => 0,
    };
    return bless $self, $class;
}

sub add
{
    my ($self,$keyobj) = @_;
    $self->{counter}++;
    $self->{size} += $keyobj->{size};
}

sub get_count
{
    return $_[0]->{counter};
}

sub get_size
{
    my ($self,$value_only) = @_;

    my $size = $self->{size};
    return $size if $value_only;


    my $unit = $size > 1024**9 ? sprintf("%.2f TB",$size / 1024**9)
             : $size > 1024**6 ? sprintf("%.2f GB",$size / 1024**6)
             : $size > 1024**3 ? sprintf("%.2f MB",$size / 1024**3)
             : $size > 1024    ? sprintf("%.2f kB",$size / 1024)
             :                   "$size bytes"
             ;

    return $unit;
}
### EOP ###
1;


package S3;
use parent 'Net::Amazon::S3';

sub new
{
    my $class = shift;
    my ($conf) = @_;
    my $self = Net::Amazon::S3->new({
                  aws_access_key_id     => $conf->{authkeyid},
                  aws_secret_access_key => $conf->{authsecret},
                  host                  => $conf->{endpoint},
               });

    bless $self, $class;
    return $self;
}


sub bucket
{
    my ($self,$Bucket) = @_;

    return $self->SUPER::bucket($Bucket);
}



### EOP ###
1;
