#! /usr/bin/perl
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
#  
#  
# Licensed Materials - Property of IBM 
#  
# (C) COPYRIGHT International Business Machines Corp. 2008,2021 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 

# sccsid = "@(#)76   1.16   src/rsct/trace/trcspl/chkspool.perl, trace, rsct_rady, radys004a 10/6/21 09:46:14"
# Search on "sub help" and/or "sub usage" for script description.
# Run with CHKSPOOL_DEBUG=1 chkspool <args>, to ciew debug output

use strict;
use warnings;
use Getopt::Long;
use Fcntl ':mode';
use Time::Local;
use File::Basename;
use Fcntl ':flock';
use POSIX qw(:errno_h);
use constant PID_LCK => "/var/ct/lck/chkspool_pid.lock";

my $debug_enabled = (defined $ENV{"CHKSPOOL_DEBUG"}  && 
                               $ENV{"CHKSPOOL_DEBUG"} eq 1);
my $force_kill_flag = 0;
my $script_name = basename($0);
my $script_pid = $$;

my $days_limit = -1;
my $megabytes_limit = -1;
my $spool_dir = ""; 
my $help = 0;
my %category_count = ();

if (!GetOptions("X" => \$force_kill_flag, 
                "spool_dir=s" => \$spool_dir, 
                "days_limit=i" => \$days_limit, 
                "megabytes_limit=i" => \$megabytes_limit, 
                "help" => \$help, "h" =>\$help))
{
	usage(1);
}

if ($help ne 0)
{
	help();
}

if ($spool_dir eq "")
{
	usage(1);
}

if ($days_limit eq -1 and $megabytes_limit eq -1)
{
    print STDERR "Error($script_name): Either one of days limit or megabyte limit shoule be dpecified.\n";
	usage(1);
}

if ($days_limit ne -1 and $megabytes_limit ne -1)
{
    print STDERR "Error($script_name): Both of days limit and megabyte limit cannot be specified.\n";
	usage(1);
}

# Attempt to set up pid lock for this instance
my ($lockfh) = set_pid_lock();

if ($days_limit eq -1)
{
	# handle megabytes_limit
	printf "Handling megabytes_limit : megabyteslimit=%d \n",$megabytes_limit;

	my $total_spool_dir_file_kbytes = total_file_kbytes($spool_dir);
	printf "Total spool dir file Kbytes %d \n",$total_spool_dir_file_kbytes;

	my @spool_files = `/opt/rsct/bin/lstrsp --spool_dir $spool_dir --show_file_bytes`;

	foreach my $line (@spool_files)
	{
		chomp $line;
		my ($file_bytes, $spool_file) = split " ", $line, 2;
		my $file_kbytes = $file_bytes/1024;
		
		$total_spool_dir_file_kbytes -= $file_kbytes;

		if ($total_spool_dir_file_kbytes < $megabytes_limit*1024)
		{
            # Release pid lock and cleanup before exit
            close_and_cleanup_pid_lock($lockfh);
			exit 0;
		}

        # Extract trace file name, directory and suffix from absolute path
        my ($file_name, $file_dir_name, $file_suffiz) = fileparse( $spool_file );

        # split the name further to get the file category, example trace, trace.prm, trace.detail, trace.summary
        my @file_name_parts = split /\.\d+\.sp\./, $file_name;
        my $file_base_name = $file_name_parts[0];

        # If asked to clean everything ($megabytes_limit == 0) or there are more than 1 files still
        #   remaining in this directory/component, go ahead and delete this file.
        if($megabytes_limit == 0 or find_trace_file_count($file_dir_name, $file_base_name) > 1)
        {
			printf "removing %d KB %s\n", $file_kbytes, $spool_file;
            delete_spooled_file($file_dir_name, $file_base_name, $spool_file);
        }
	}

	# TODO: remove empty directories?
}
else
{
    # handle days_limit
	printf "Handling day limit: days_limit=%d \n",$days_limit;

	my ($second, $minute, $hour, $day, $month, $year, $wday, $yday, $isdst) = localtime(todays_midnight_epoch_seconds() - $days_limit*24*60*60);

	my $lstrsp_command = sprintf("/opt/rsct/bin/lstrsp --spool_dir %s --show_file_bytes -to %s", $spool_dir, sprintf("%.4u-%.2u-%.2u\n", $year + 1900, $month + 1, $day));

	open LSTRSP, "$lstrsp_command |" or die sprintf("%s: %d: cannot pipe lstrsp command\n", $0, __LINE__);

	while (<LSTRSP>)
	{
		chomp;
		my ($file_size, $file_name) = split;
		printf "removing %s\n", $file_name;
		system("rm -f $file_name");
	}
}

# Release pid lock and cleanup before exit
close_and_cleanup_pid_lock($lockfh);

exit 0;

#[functions]-----------------------------------------------------------

sub help
{
	usage();

	print STDERR <<HELP;

The chkspool utility manages a trace spool directory by permitting
pruning of spool files created before a number of days, or per a
maximum spool directory size quota in megabytes (where "number of
days" means "an integral number of days since midnight of the day in
which the command is invoked).

Examples:

# prune spool files older than 20 days since midnight of today
> chkspool --spool_dir /tmp/TraceSpool --days_limit 20

# prune spool files until the spool_dir is 100 megabytes
> chkspool --spool_dir /tmp/TraceSpool --megabytes_limit 100

Note: Only single instance of this script is allowed to execute in the 
system. Attempting to start a new instance when one is active shall 
fail with error.To force run a new instance and kill an already running
or hung one, add the -X flag with other arguments.
HELP

	exit 0;
}

sub usage
{
	print STDERR <<USAGE;

Usage:
chkspool [-X] --spool_dir <path>
         --days_limit <number> | --megabytes_limit <number>
         [--help]
USAGE

	if (undef ne $_[0])
	{
		exit $_[0];
	}
}

sub todays_midnight_epoch_seconds
{
	my ($current_second, $current_minute, $current_hour, $current_day, $current_month, $current_year, $wday, $yday, $isdst) = localtime(time);
	return timelocal(0, 0, 0, $current_day, $current_month, $current_year);
}

# arguments: month (1-12), day (1-31), year
sub midnight_epoch_seconds
{
	# note that we subtract 1 from the 1-12 month here to fit
	# timelocal()'s argument requirements
	return timelocal(0, 0, 0, $_[1], $_[0]-1, $_[2]);
}

sub total_file_kbytes
{
	my $cumulative_bytes = 0;
	my $cumulative_kbytes = 0;

#	open FIND, "find $_[0] -type f -ls|" or die sprintf "%d: ooops\n", __LINE__;
	open FIND, "find $_[0] -type f -ls|" or return 0;

	while (<FIND>)
	{
		my @files = split;

		$cumulative_bytes += $files[6];
		if($cumulative_bytes >= 1024) {
			$cumulative_kbytes += ($cumulative_bytes>>10); #KBs
			$cumulative_bytes  %= 1024; # remaining bytes to process
		}

	}

	close FIND;

	$cumulative_kbytes += $cumulative_bytes/1024; # kbytes is now a float value 
	return $cumulative_kbytes;
}

# Find the count of files in given category in the search directory/component
sub find_trace_file_count {
    my ($search_dir, $file_type) = @_;
    my $search_count = 0;
    my $search_dir_bn = basename $search_dir;

    # The hash table key for a trace category in a specific directory: <dir_path>_<trace.category>
    my $category_key = "${search_dir}_${file_type}";
    if(exists $category_count{$category_key}) {  # if this category count is already cached, use it
        $search_count = $category_count{$category_key};
    }
    else{ # This category is not calculated and cached, get the count and cache it now...
        # Only current directory (not its subdir)
        my $search_cmd = "find $search_dir \\( -name $search_dir_bn -o -prune \\) -type f -name \'${file_type}.[0-9]*.sp.*\' | wc -l";
        $search_count = `$search_cmd`;
        chomp $search_count;

        # Create a new category entry and add the count to the cache...
        $category_count{$category_key} = $search_count;
    }
    # print "$search_count\t$file_type\t\t$search_dir_bn\n" if($search_count ne 0);
    return $search_count;
}

sub delete_spooled_file {
    my ($search_dir, $file_type, $spool_file) = @_;

    system("rm -f $spool_file");

    # Update the count for the category in the cache to reflect the deletion
    my $category_key = "${search_dir}_${file_type}";
    $category_count{$category_key} -= 1 if(exists $category_count{$category_key});
}

sub check_if_already_runnig
{
   my $rc = 0;
    my $pid_lock_path = PID_LCK;
    my $pid = $$;

    return $rc if(! -e $pid_lock_path);
    print "INFO($script_name): Found existing pid lock file.\n" if($debug_enabled);
    open(my $LCKFH, "<$pid_lock_path") or die("Error($script_name): Couldn't open pid lock file, $!\n");
    print "INFO($script_name): Successfully opened pid lock file.\n" if($debug_enabled);
    flock($LCKFH, LOCK_SH | LOCK_NB) or die("Error($script_name): Aquiring SH lock, $!");
    print "INFO($script_name): Aquired shared lock on pid lock file.\n" if($debug_enabled);
    my $existing_pid = <$LCKFH>;
    chomp($existing_pid);
    $existing_pid =~ s/^\s*(.*?)\s*$/$1/;
    print "INFO($script_name): Detected pid [$existing_pid] in file.\n" if($debug_enabled);
    my $procinfo = `ps ${existing_pid} | tail -1`;
    chomp($procinfo);
    $rc = $existing_pid if($procinfo =~ /$script_name/);
    print "INFO($script_name):Closing pid lock file.\n" if($debug_enabled);
    close($LCKFH);
    print "INFO($script_name): Returning with RC=$rc.\n" if($debug_enabled);
   return $rc; 
}

sub close_and_cleanup_pid_lock
{
    my ($pidlckfh) = @_;
    print "INFO($script_name): Attempting to close and remove pid lock file.\n" if($debug_enabled);
    close($pidlckfh) or print STDERR "INFO($script_name): Pid lock file not closed, $!\n";
    unlink(PID_LCK) or print STDERR "INFO($script_name): Couldn't remove pid lock, $!\n";
}

sub force_kill_old_and_start_fresh
{
    my $kill_old_pid = shift;
    print "INFO($script_name): Attempting to kill old instance with pid [$kill_old_pid].\n" if($debug_enabled);
    kill('KILL', $kill_old_pid) or print STDERR "INFO($script_name): Failed to kill pid [$kill_old_pid], $!\n";
    sleep(3);

    # Re-check if the old process terminated, else fail with error!
    my $kill_rc = kill(0, $kill_old_pid);
    my $errmsg = $!;
    if ($kill_rc ne 0)
    {
        Print STDERR "Error($script_name): Failed to verify if $script_name [pid: $kill_old_pid] still running, kill(): $errmsg\n";
    }
    else
    {
        print "INFO($script_name): Attempting to delete old pid lock file...\n" if($debug_enabled);
        unlink(PID_LCK) or print STDERR "INFO($script_name): Failed to remove old pid lock file, $!\n";
    }
}


sub set_pid_lock
{
    my $exec_status = check_if_already_runnig();
    print "INFO($script_name): Instance check returned [$exec_status].\n" if($debug_enabled);
    if($exec_status ne 0)
    {
        if($force_kill_flag eq 1)
        {
            force_kill_old_and_start_fresh($exec_status);
        }
        else
        {
            print STDERR "Error($script_name): Another instance of $script_name is running.PID:[$exec_status]\n";
        print STDERR "Please retry by adding '-X' flag to kill old instance and start this one...\n";
            exit 5;
        }
    }

    my $open_expr = "+>" . PID_LCK;
    # Setting buffered IO off, to immediately flush PID to disk
    $| = 1;
    open(my $LCKFH, $open_expr) or die("Error($script_name): Couldn't open pid lock file, $!\n");
    print "INFO($script_name): Opened pid lock to write self pid.\n" if($debug_enabled);

    # Aquire the Exclusive lock to avoid other instances to read
    #  invalid data from the file. Also, this would let this instance
    #  know if another instance is also competing for setting the pid
    #  lock, so that we can fail over it...
    flock($LCKFH, LOCK_EX | LOCK_NB) or die("Error($script_name): Aquiring EX lock, $!");
    print "INFO($script_name): Aquired Exclusive lock on pid lock.\n" if($debug_enabled);
    print $LCKFH "$$" or die("Error($script_name): Writing to pid lock, $!");
    print "INFO($script_name): Self pid [$$] written to pid lock.\n" if($debug_enabled);

    # Release Exclusive lock and aquire Shared lock to allow other
    #  instances to detect the pid of this process, so that, other
    #  instance may report error with this pid or force kill this one
    #  if instructed to do so.
    flock($LCKFH, LOCK_UN) or die("Error($script_name): Failed to unlock, $!\n");
    flock($LCKFH, LOCK_SH | LOCK_NB) or die("Error($script_name): Failed to unlock, $!\n");
    print "INFO($script_name): Switched from Exclusive lock to shared lock on pid lock file.\n" if($debug_enabled);
    return $LCKFH;
}