#!/usr/bin/perl

use strict;
use warnings;

use Redis;
use Config::Tiny;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use Data::Dumper;

my ($verbose, $man, $help);

GetOptions(
    "verbose" => \$verbose,
    "man" => \$man,
    "help" => \$help,
);

if ($man) {
    pod2usage(-verbose => 2);
    exit(0);
}
if ($help) {
    pod2usage(-verbose => 1);
    exit(0);
}

my $config = Config::Tiny->read('/etc/ngcp-usr-location/ngcp-usr-location.conf');
my $kamailio_config = '/etc/kamailio/proxy/kamailio.cfg';
my $redis_db_host = $config->{_}->{REDIS_IP} // 'localhost';
my $redis_db_port = $config->{_}->{REDIS_PORT} // 6379;
my $redis_db_db   = $config->{_}->{REDIS_LOC_DB} // 20;

sub debug {
    my $msg = shift;
    print "$msg\n" if $verbose;
}

my $loc_prefix = '1:';

### parse map keys

my $location_def;
open my $fh, '<', $kamailio_config
    or die "Failed to open kamailio config '$kamailio_config': $!";
while (<$fh>) {
    chomp;
    last if /^route/;
    next unless /^modparam\("db_redis"\s*,\s*"keys"\s*,\s*"${loc_prefix}location=([^"]+)/;
    $location_def = $1;
    last if defined $location_def;
}
close $fh;
defined $location_def
    or die "Failed to find redis location key definition in '$kamailio_config'\n";

my %maps = ();
my %ent_keys = ();
foreach my $defs (split /&/, $location_def) {
    my ($name, $parts) = split /:/, $defs;
    my @parts = split /,/, $parts;
    if ($name ne "entry") {
        $maps{$name} = \@parts;
        %ent_keys = (%ent_keys, (map {$_ => 1} @parts));
    }
}
my @ent_keys = keys(%ent_keys);

debug("Map key definition:");
debug(Dumper \%maps);
debug("Entry keys:");
debug(Dumper \@ent_keys);

### execute cleanup

debug("Conneting to Redis");
my $r = Redis->new(server => "$redis_db_host:$redis_db_port") or die "Failed to connect to Redis: $!";
$r->select($redis_db_db) or die "Failed to select Redis DB: $!";

my $now = time();
my $key_script = $r->script_load('redis.call("SREM", KEYS[1], KEYS[3]); if redis.call("SCARD", KEYS[1]) == 0 then redis.call("SREM", KEYS[2], KEYS[1]) end; return true')
    or die "Failed store LUA script in Redis: $!";
my $set_script = $r->script_load('if redis.call("SISMEMBER", KEYS[1], KEYS[2]) == 1 and redis.call("EXISTS", KEYS[2]) == 0 then redis.call("SREM", KEYS[1], KEYS[2]) end; return true')
    or die "Failed store LUA script in Redis: $!";

my ($all_count, $del_count, $cursor) = (0,0,0);

debug("Start scanning Redis location keys");

do {
    my $res = $r->scan($cursor, 'MATCH', "${loc_prefix}location:entry::*", 'COUNT', 1000)
        or die "Failed to scan Redis keys: $!";
    $cursor = $res->[0];

    debug("  Iterating over next batch of Redis location keys");

    for my $entry (@{$res->[1]}) {
        $all_count++;
        my $ent = $r->hmget($entry, @ent_keys);
        next unless $ent;
        my %hent = map {$ent_keys[$_] => $ent->[$_]} (0 .. $#ent_keys);
        next if $hent{expires} > $now;
	next if $hent{expires} == 0;
        debug("    Entry $entry is expired ($hent{expires}), deleting");
        for my $key (keys(%maps)) {
            my $map = $maps{$key};
            my $mapname = "${loc_prefix}location:index::$key";
            my $keysuff = join(':', (map {$hent{$_}} @{$map}));
            my $keyname = "${loc_prefix}location:$key";
            $keyname .= "::$keysuff" if $keysuff;
            $r->evalsha($key_script, 3, $keyname, $mapname, $entry)
                or die "Failed to execute LUA script: $!";
        }
        $r->srem("${loc_prefix}location:master", $entry);
        $r->del($entry);
        $del_count++;
    }
    sleep(0.1);

    debug("  $all_count entries checked so far and $del_count deleted");
} while ($cursor);

print("$all_count entries checked and $del_count deleted\n");

### check auxilliary maps

for my $key (keys(%maps)) {
    debug("Start scanning '$key' Redis map");
    my $map = $maps{$key};
    my $matchkey = "${loc_prefix}location:${key}";
    $matchkey .= '::*' if @{$map};

    ($all_count, $del_count, $cursor) = (0,0,0);

    do {
        my $res = $r->scan($cursor, 'MATCH', $matchkey, 'COUNT', 1000)
            or die "Failed to scan Redis keys: $!";
        $cursor = $res->[0];

        debug("  Iterating over next batch of '$key' Redis map entries");

        for my $set_name (@{$res->[1]}) {
            my $set_cursor = 0;

            do {
                my $set_res = $r->sscan($set_name, $set_cursor, 'COUNT', 1000)
                    or die "Failed to scan Redis set members $!";
                $set_cursor = $set_res->[0];

                for my $set_member (@{$set_res->[1]}) {
                    $r->evalsha($set_script, 2, $set_name, $set_member)
                        or die "Failed to execute LUA script: $!";
                    $all_count++;
                }
                sleep(0.1);
            } while ($set_cursor);
            debug("    $all_count set members checked so far");
        }
    } while ($cursor);

    debug("  Checking '$key' master index");

    my $set_cursor = 0;

    do {
        my $set_res = $r->sscan("${loc_prefix}location::index::$key", $set_cursor, 'COUNT', 1000)
            or die "Failed to scan Redis set members $!";
        $set_cursor = $set_res->[0];

        for my $set_member (@{$set_res->[1]}) {
            $r->evalsha($set_script, 2, "${loc_prefix}location::index::$key", $set_member)
                or die "Failed to execute LUA script: $!";
            $all_count++;
        }
        sleep(0.1);
    } while ($set_cursor);
    debug("  $all_count set members checked so far");
}
print("$all_count set members checked\n");

__END__

=head1 NAME

ngcp-location-cleanup - Delete expired location entries from Redis

=head1 SYNOPSIS

B<ngcp-location-cleanup> [I<option>...]

=head1 DESCRIPTION

B<This program> will slowly and gracefully iterate all location entries stored
in Redis and delete expired entries. It can safely be executed at any time
without impacting service.

=head1 OPTIONS

=over

=item B<--verbose>, B<-v>

Print debugging.

=item B<--help>, B<-h>

Brief help message.

=item B<--man>, B<-m>

Full documentation.

=back

=head1 LICENSE

B<This program> is licensed under GPL-3+.

=head1 AUTHOR

Richard Fuchs (rfuchs@sipwise.com)

=cut
