#!/usr/local/bin/perl -T
#
#Script to be run in cron job (daily?) to do a "soft" quota check
#on home directories on HPC clusters

use strict;
use warnings;

$ENV{PATH}="/usr/bin:/bin"; #Make taint happy

use lib "/cell_root/software/HPCC/lib/site_perl";
#Temporary for debugging
#use lib "/afs/.glue.umd.edu/software/HPCC/1.1/lib/site_perl";

use Glue::HPCC::Cluster;
use Glue::Misc::Units qw(scale_size);
use Glue::HPCC::Utils::SoftQuotaCheck;
use POSIX qw(strftime);

use Getopt::Long;

#------------------------------------------------------
#			 Globals
#------------------------------------------------------

my $VERBOSE;
my $DEBUG;
my ($cluster, $grace, $softquota, $rootdirs, $statusfile, $minage);
my ($excludedirs, $warning_template, $violation_template );
my $TEMPLATE_ROOT = '/cell_root/software/HPCC/templates';

sub usage()
{	my $rootdirstr = join ", ", @$rootdirs;
	my $excdirstr = join ", ", @$excludedirs;
	print STDERR <<EOF;
$0: Script to do soft quota check of homespaces on HPCC

Usage:
$0 [ -debug ] [ -verbose ] [ -[no]email ] [ -[no]update ]

This script will search all home directory directories for the 
HPC cluster (based on the hostinfo settings of host running on), 
finding those that exceed the soft quota (actually, usually the soft 
quota plus a small play factor, ~ 10%).  It will track recent 
history of such excesses, and sort into two classes depending on whether 
they have exceeded the soft quota continuously for more than grace days.  

Violators are those who have exceeded usage beyond the grace period, and who
will receive an email (sysadmins cc'ed) informing them to reduce
usage immediately as are in violation of HPCC policy.  Others receive a 
warning that they have grace-N days before they are in violation.

A status file statusfile keeps tracks of recent overages.

Variables are either hard coded or from the HPC cluster.
	CLUSTER => $cluster
	ROOTDIRS => [ $rootdirstr ]
	GRACE => $grace (days)
	SOFTQUOTA => $softquota (GB)
	STATUSFILE => $statusfile
	MINAGE => $minage (days)
	EXCLUDEDIRS => [ $excdirstr ]
	WARNING_TEMPLATE => $warning_template
	VIOLATION_TEMPLATE => $violation_template

--nomail will disable mailings (will print summary instead)
--noupdate will disable updating of statusfile

EOF
}

sub debug(@)
{	my @args = @_;
	return unless $DEBUG;
	my $text = join '', @args;
	chomp $text;
	print STDERR "[DEBUG] $text\n";
}

sub verbose(@)
{	my @args = @_;
	return unless $VERBOSE;
	my $text = join '', @args;
	chomp $text;
	print STDERR "[DEBUG] $text\n";
}

sub dump_user_results($$)
{	my $urec = shift;
	my $strec = shift;

	my ( $uname, $uid, $email ) = @$urec;
	my $sizeBytes = $strec->{size};
	my $firstWarn = $strec->{firstWarning};
	my $firstErr  = $strec->{firstError};
	my $warnings = $strec->{warnings};
	my $errors =   $strec->{errors};

	my ($size, $unit)  = scale_size($sizeBytes, '', 'auto');
	my $tstr;
	my $tfmt = "%Y-%m-%d";
	my $wecnt = ($warnings?$warnings:0) + ($errors?$errors:0);

	print "\t$uname ($uid): using $size ${unit}B "; 
	if ( defined $firstErr )
	{	#Violation record
		$tstr = strftime($tfmt, localtime($firstErr));
		print "over grace since $tstr ($wecnt warnings)\n";
	} else
	{	#Warning record
		$tstr = strftime($tfmt, localtime($firstWarn));
		print "over quota since $tstr ($warnings warnings)\n";
	}
}

sub dump_results($$$)
{	my $status = shift;
	my $viols = shift || [];
	my $warns = shift || [];

	#use Data::Dumper;
	#print STDERR "[[DEBUG]]: status = $status\n", Dumper($status), "\n\n";

	my ($uname, $urec, $strec);
	if ( @$viols)
	{	print <<EOF;
Users over quota and exceeding grace period:
EOF
		foreach $urec (@$viols)
		{	$uname = $urec->[0];
			$strec = $status->{$uname};
			dump_user_results($urec, $strec);
		}
	} else
	{	print "No users exceeding grace period.\n";
	}

	if ( @$warns)
	{	print <<EOF;

Users over quota but within grace period:
EOF
		foreach $urec (@$warns)
		{	$uname = $urec->[0];
			$strec = $status->{$uname};
			dump_user_results($urec, $strec);
		}
	} else
	{	print "No users overquota but within grace period.\n";
	}

}



#------------------------------------------------------------
#			Main code
#------------------------------------------------------------

my $help;
my $do_email=1;
my $do_update=1;

my $res = GetOptions(
	'help!' => \$help,
	'debug!' => \$DEBUG,
	'verbose!' => \$VERBOSE,
	'email|mail!' => \$do_email,
	'update!' => \$do_update,

	#'cluster=s' => \$cluster,
);

unless ( $res )
{	usage;
	die "\nError parsing options.\n";
}

my $hpc = Glue::HPCC::Cluster->new_from_clustername($cluster);
die "\nInvalid cluster $cluster at " if $cluster && ! $hpc && ! ref($hpc);
die "\nError instantiating cluster $hpc " unless $hpc && ref($hpc);
$cluster = $hpc->db_clustername;
my $clustername = $hpc->clustername;
my $sqc = Glue::HPCC::Utils::SoftQuotaCheck->new(hpc=>$hpc);

#Constants, might eventually want to take from Glue::HPCC::Cluster
$grace = 7; #days
$softquota = 10; #GB
$statusfile = '/software/glue-cluster/quotas/homespace-status.dat';
$minage = 0;
$excludedirs = [ '.images', 'pending_deletion' ];
$warning_template = "$TEMPLATE_ROOT/${cluster}_homespace_quota_warning.tmplate";
$violation_template = 
	"$TEMPLATE_ROOT/${cluster}_homespace_quota_violation.tmplate";

#Taken from Glue::HPCC::Cluster
my @homedirs = ( $hpc->homeroot_user );

@homedirs = grep { $_ } @homedirs; #Drop nulls
my %homedirs = map { $_ => undef } @homedirs; #Remove duplicates
@homedirs = keys %homedirs;
die "No roots for home directories for cluster $cluster found, aborting.\n"
	unless @homedirs;
$rootdirs = [ @homedirs ];

if ( $help )
{	usage;
	exit 0;
}

debug("Entering DEBUG mode.");
$sqc->DEBUG($DEBUG);
$sqc->VERBOSE($VERBOSE);

my $noemail = $do_email?0:1;
my $noupdate = $do_update?0:1;

#print STDERR "Forcing noemail=1\n";
#$noemail=1;

my ( $status, $viols, $warns) = $sqc->soft_quota_check(
	rootdirs => $rootdirs,
	quotaGB => $softquota,
	#playGB => 1,
	'play%' => 10,
	grace => $grace,
	excludedirs => $excludedirs,
	statuslog => $statusfile,
	'suppress-email' => $noemail, 
	'suppress-update' => $noupdate,
	'warning-template' => $warning_template,
	'violation-template' => $violation_template,
	nonunique => 0,
	# percent-used => 0,
	# age => $minage,
);

if ( $noemail )
{	dump_results($status, $viols, $warns);
}
