#!/usr/local/bin/perl

use strict;
use warnings;

#use lib '/cell_root/software/HPCC/lib/site_perl';
#For testing, use RW replica
use lib '/afs/.glue.umd.edu/software/HPCC/1.1/lib/site_perl';

use Glue::HPCC::Cluster;
use Glue::HPCC::Utils::FileUtils qw(
	archive_data_dir
	archive_home_dir
);
use Glue::HPCC::Project::Person;
use Glue::HPCC::Project::PersonProject;

use Glue::HPCC::Utils::UserRevocationReasons;

use Getopt::Long;
use File::Basename;
use Time::ParseDate;
#use Data::Dumper;

my %deftype_by_basename =
(	'archive_lustre_dir' => 'lustre-data',
	'archive_nfs_dir' => 'nfs-data',
	'archive_home_dir' => 'home',
);
my $deftype = $deftype_by_basename{basename($0)};

my $DEBUG;
$DEBUG=1;

my $defExpiration = "6 months";

my $urevoc_options = {};


sub usage();
$urevoc_options->{usage_sub} = \&usage;
sub usage()
{	my $urevoc_help = Glue::HPCC::Utils::UserRevocationReasons->help_text(
		$urevoc_options);
	print STDERR <<EOF;
$0: Archive a directory

Usage:
$0 [ --dtype DTYPE ] [ -expiration EXPIRY ] [ -projects PROJS ] \
	[ --uid UID ] [ --owner OWNER ] [ --fullname FNAME ] \
	[--dryrun ] [ --force ] [ _reason_options_ ]  PATH

The directory pointed to by PATH will be "archived", i.e. renamed
to a "pending-deletion" directory with restricted access.  A
".readme" file with metainfo will be created as well.

If PATH is not absolute, we will try relative to the current directory
and then relative to the normal root directory for data of this
type on this cluster.

DTYPE will be defaulted based on what program was called (in this case
'$deftype'), value should be one of 'lustre-data', 'nfs-data', or 'home'.

EXPIRY defaults to $defExpiration from now, and is when the archive expires/
can be deleted.

PROJS is a comma separated list of project names the owner of the directory
belongs to.  It can be repeated to add additional project names.

UID defaults to the uid owning the directory.  OWNER (the username of the
owner) and FNAME (the human readable name) will be defaulted from UID
using the cluster PDB if possible otherwise the password file.

You will need to provide reasons for the archiving of the directory.
Because these are sent to users at some point, we want them to be somewhat
formal and consistent, so 'canned' options for common situations exist.
The various reason related options are:
$urevoc_help

If --force is set, code is willing to clobber existing stuff.  By default
will not clobber anything.

EOF
}

sub archive_directory(@)
#Does the actual work of archiving the directory (or at least setting
#up the call to the method in FileUtils to do so).
#Takes key => value pairs for arguments, recognizing
#	directory: path to directory to archive, REQUIRED
#	dtype: one of 'lustre-data', 'nfs-data', or 'home', REQUIRED
#	hpc: A Glue:HPCC::Cluster instance, used to access PDB for defaulting
#		some values.
#	expiration: when archive expires.  Defaults to 6 months from now
#	exptstamp: when archive expires, in seconds from 1970.
#	projects: list ref of project names owner belongs to.  Defaults to 
#		projects the owner belongs to if $hpc is given, or [] if not.
#	uid: uid of owner.  Defaults to uid of directory in filesystem
#	owner: username of owner.  Default from PDB and $uid if $hpc, or from
#		/etc/passwd and $uid otherwise
#	fullname: fullname of owner.  Default from PDB and $uid if $hpc, or from
#		/etc/passwd and $uid otherwise
#	reason: list ref of reasons.  REQUIRED. 
#	force: if set, we are willing to clobber existing archives/metainfo/etc.
#
#expiration, exptstamp, projects, uid, owner, fullname all just passed to
#FileUtils archiving routines (which will do any defaulting).
{	my %args = @_;
	my $me = 'archive_directory';

	my $dir = delete $args{directory};
	my $dtype = delete $args{dtype};
	my $hpc = delete $args{hpc};
	my $expiration = delete $args{expiration};
	my $exptstamp = delete $args{exptstamp};
	my $projects = delete $args{projects};
	my $uid = delete $args{uid};
	my $owner = delete $args{owner};
	my $fullname = delete $args{fullname};
	my $reason = delete $args{reason};
	my $force = delete $args{force};

	if ( scalar(%args) )
	{	my @temp = keys %args;
		my $temp = join ", ", @temp;
		die "$me: Extraneous arguments [ $temp ], aborting.\n";
	}

	die "$me: Missing required parameter 'directory' at " unless $dir;
	die "$me: Missing required parameter 'dtype' at " unless $dtype;
	die "$me: Missing required parameter 'reason' at " unless $reason;
	$reason = [ $reason ] unless ref($reason) eq 'ARRAY';
	die "$me: Empty list for reason at " unless scalar(@$reason);

	die "$me: Illegal value '$hpc' for hpc, expecting " .
		"Glue::HPCC::Cluster instance at "
		if $hpc && ! ref($hpc);
	$dtype = lc $dtype;
	die "$me: Illegal value '$dtype' for dtype, expecting " .
		"one of 'home', 'lustre-data', 'nfs-data' at "
		unless $dtype eq 'home' || $dtype eq 'lustre-data' ||
			$dtype eq 'nfs-data';

	my $rawdir = $dir;
	$dir = undef;
	if ( -e $rawdir ) 
	{	#$dir points to something, is it a directory?
		die "$me: $rawdir points to non-directory at " 
			unless ( -d $rawdir );
		$dir = $rawdir;
	} elsif ( $hpc )
	{	#Try prefixing with appropriate root dir
		my @roots = ();
		my $tmpdirs;
		if ( $dtype eq 'home' )
		{	$tmpdirs = $hpc->homeroot_user;
			push @roots, $tmpdirs if $tmpdirs;
			$tmpdirs = $hpc->homeroot_admin;
			push @roots, $tmpdirs if $tmpdirs;
		} elsif ( $dtype eq 'lustre-data' )
		{	$tmpdirs = $hpc->lustre_filesystems;
			push @roots, @$tmpdirs 
				if $tmpdirs && ref($tmpdirs) eq 'ARRAY';
		} elsif ( $dtype eq 'nfs-data' )
		{	$tmpdirs = $hpc->nfs_data_filesystems;
			push @roots, @$tmpdirs 
		} else
		{	die "$me: Unrecognized dtype '$dtype' at ";
		}

		ROOTS: foreach $tmpdirs (@roots)
		{	print STDERR "[DEBUG] Trying rooted at $tmpdirs...\n";
			if ( -e "$tmpdirs/$rawdir" )
			{	if ( -d "$tmpdirs/$rawdir" )
				{	$dir = "$tmpdirs/$rawdir";
					print STDERR "[DEBUG] Found match at $dir\n" 
						if $DEBUG;
					last ROOTS;
				} else
				{	die "$me: Found match at $tmpdirs/$rawdir, but non-directory at ";

				}
			}
		}

		die "$me: Unable to find $rawdir (absolute, relative to CWD, " .
			"relative to HPC rootdirs) at " unless $dir;
	} else
	{	die "$me: Unable to find $rawdir (absolute, relative to CWD) at ";
	}

	if ( $dtype eq 'home' )
	{	archive_home_dir(
			directory => $dir,
			fstype => $dtype,
			force => $force,
			reason => $reason,
			hpc => $hpc,
			uid => $uid,
			owner => $owner,
			fullname => $fullname,
			projects => $projects,
			expiration => $expiration,
			exptstamp => $exptstamp,
		);
	} elsif ( $dtype eq 'lustre-data' || $dtype eq 'nfs-data' )
	{	archive_data_dir(
			directory => $dir,
			fstype => $dtype,
			force => $force,
			reason => $reason,
			hpc => $hpc,
			uid => $uid,
			owner => $owner,
			fullname => $fullname,
			projects => $projects,
			expiration => $expiration,
			exptstamp => $exptstamp,
		);
	} else
	{	die "$me: Unrecognized dtype=$dtype at ";
	}
	return;
}

#=====================================================================
#	Main
#=====================================================================
	
my $help;
my $dir;
my $dtype = $deftype;
my $projects = [];
my ( $uid, $owner, $fullname);
my ( $force, $dryrun, $verbose );
my $expiration = "now + $defExpiration";

my $urevoc_flags = {};
my $urevoc_args = Glue::HPCC::Utils::UserRevocationReasons->make_arglist(
	$urevoc_flags, $urevoc_options);

my $res = GetOptions(
	'help!' => \$help,
	'dryrun!' => \$dryrun,
	'force!' => \$force,
	'debug!' => \$DEBUG,
	'verbose!' => \$verbose,

	'dtype=s' => \$dtype,
	'directory|dir|path=s' => \$dir,
	'expiration|expiry=s' => \$expiration,
	'project|projects=s' => $projects,
	'uid=i' => \$uid,
	'owner|user=s' => \$owner,
	'fullname|full-name|full_name|fname=s' => \$fullname,

	@$urevoc_args,
);

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

unless ( $dir )
{	$dir = shift @ARGV;
}

if ( @ARGV )
{	my $temp = join ", ", @ARGV;
	usage;
	die "Extraneous arguments [ $temp ], aborting.\n";
}

unless ( $dir )
{	usage;
	die "You must provide a directory to archive.\n";
}
unless ( $dtype )
{	usage;
	die "Datatype not given and cannot be defaulted under this program name.\n";
}

$urevoc_options->{noconfirm} = 1 if $force;
my ($reason, $logreason) = Glue::HPCC::Utils::UserRevocationReasons->process_arghash(
	$urevoc_flags, $urevoc_options);

#Default cluster if needed
my $hpc = Glue::HPCC::Cluster->new_from_clustername();
die "\nError instantiating cluster $hpc " unless $hpc && ref($hpc);
my $cluster = $hpc->db_clustername;

$hpc->verbose($verbose);
$hpc->dryrun($dryrun);
#Glue::HPCC::Utils::MailUtils::verbose($verbose);
#Glue::HPCC::Utils::MailUtils::dryrun($dryrun);
Glue::HPCC::Utils::FileUtils::verbose($verbose);
Glue::HPCC::Utils::FileUtils::dryrun($dryrun);

my $tstamp;
if ( $expiration )
{	$tstamp  = parsedate($expiration, 
		WHOLE => 1,
		PREFER_FUTURE => 1,
		VALIDATE => 1,
	);
	die "Invalid expiration date '$expiration'\n" unless defined $tstamp;
} else
{	$tstamp = time + 60*60*24*31*6; #6 months from now, more or less
}

#Handle CSV values in projects
my @temp = @$projects;
$projects = [];
foreach my $rec (@temp)
{	my @projs = split /\s*,\s*/, $rec;
	push @$projects, @projs;
}

$projects = undef unless scalar(@$projects);

my $err = archive_directory(
	directory => $dir,
	dtype => $dtype,
	hpc => $hpc,
	exptstamp => $tstamp,
	projects => $projects,
	uid => $uid,
	owner => $owner,
	fullname => $fullname,
	reason => $reason,
	force => $force,
);

die "Error archiving directory: $err\n" if $err;
exit 0;
