#!/usr/bin/env perl

##
## threshold.pl
##
## Migrates runs in chronological order until the target threshold
## of disk usage is reached.
##

use warnings;
use strict;
use Getopt::Long;

use lib $ENV{ 'NMI_LIB' } || "/nmi/lib";
use NmiConf;

# Does perl not have these as part of the language strictly to annoy me?
use constant { true => 1, false => 0 };

my %dispatchTable = (   'clean'     => \&clean,
                        'migrate'   => \&migrate,
                        'no-op',    => \&no_op );

## Command-line parsing.
my( $opt_help, $opt_percentage, $opt_space_dir, $opt_target_dir, 
    $opt_notify, $opt_source_host, $opt_target_host, $opt_date_limit,
    $opt_force_clean, $opt_only, $opt_start_limit, $opt_directory, $opt_debug );
GetOptions(
    'nmiconf=s'     => \$main::opt_nmiconf,
    'help'          => \$opt_help,
    'percentage=s'  => \$opt_percentage,
    'space-dir=s'   => \$opt_space_dir,
    'target-dir=s'  => \$opt_target_dir,
    'notify=s'      => \$opt_notify,
    'source-host=s' => \$opt_source_host,
    'target-host=s' => \$opt_target_host,
    'date-limit=s'  => \$opt_date_limit,
    'force-clean'   => \$opt_force_clean,
    'start-limit=s' => \$opt_start_limit,
    'only=s'        => \$opt_only,
    'directory=s'   => \$opt_directory,
    'debug'         => \$opt_debug
    );
my $command = $ARGV[0];

usage(0) if defined( $opt_help );
usage(1) unless defined( $opt_percentage );
usage(1) unless defined( $opt_source_host );

usage(1) unless defined( $command );
if( $command eq "migrate" ) {
    usage(1) unless defined( $opt_target_host );
    }
else{
    usage(1) unless defined( $dispatchTable{ $command } );
    }
    
## Initialization.
my %conf = NmiConf::init( $main::opt_nmiconf );
use NmiDatabaseVariables;
use NmiDatabase;

use File::Basename;
my $directory = defined( $opt_directory ) ? $opt_directory : dirname( $0 );

$opt_space_dir = $conf{ 'RUN_DIR' } unless defined( $opt_space_dir ) && $opt_space_dir ne "";
my $target_dir_option = defined( $opt_target_dir ) ? "--remote-dir=$opt_target_dir" : "";

## Fetch the runs in chronological order.
my $query = qq/
    SELECT * FROM $NmiDatabaseVariables::DB_TABLE_RUN
    WHERE   host = '$opt_source_host' AND
            finish IS NOT NULL /;
if( defined( $opt_date_limit ) ) {
    $query .= qq/AND
            finish <= '$opt_date_limit' /;
    }
if( defined( $opt_start_limit ) ) {
    $query .= qq/AND
            start >= '$opt_start_limit' /;
    }
if( defined( $opt_only ) ) {
    if( -d $opt_only ) {
        # Directory names must point to .../<gid>.
        # basename(), nicely enough, removes trailing /s for us.
        $opt_only = basename( $opt_only );
        }

    $query .= qq/AND
            (gid = '$opt_only' OR runid = '$opt_only') /;
    }
$query .= qq/
    ORDER BY finish
    /;
my @rows = getRuns( $query );

## Main migration loop.
my $index = 0;
for( my $percentageSpaceUsed = findPercentageSpaceUsed( $opt_space_dir );
     $percentageSpaceUsed >= $opt_percentage && $index <= $#rows;
     $percentageSpaceUsed = findPercentageSpaceUsed( $opt_space_dir ), ++$index ) {
    if( $opt_debug ) { print( "Disk is $percentageSpaceUsed" . "% full...\n" ); }

    my $row = $rows[$index];
    $dispatchTable{ $command }->( $row );
    } # end main loop.

print(  "Finished after migrating $index run(s).  " 
        . findPercentageSpaceUsed( $opt_space_dir ) . "% used (target "
        . "was " . $opt_percentage . "%).\n" );

## End main script.
exit 0;

##
## Commands
##

sub no_op {
    my $row = $_[0];
    print( "Performing no operation on GID " . $row->{ 'gid' } . "\n" );
    return true;
    }

sub migrate {
    my $row = $_[0];

    if( $opt_debug ) { print( "Migrating GID " .  $row->{ 'gid' } . " from " . $row->{ 'finish' } . "...\n" ); }
    my $command = qq#$directory/nmi_migrate_run $target_dir_option $opt_target_host $row->{ 'gid' }#;
    if( $opt_debug ) { print( $command . "\n" ); }
    my $rv = system( $command );
    if( $rv == -1 ) {
        print( "Unable to execute '$command', aborting. ($!)\n" ); 
        exit -1;
        }
    if( $rv != 0 || $? != 0 ) {
        print( "Failed to migrate ('$command'), continuing. ($rv, $?)\n" );
        return false;
        }
    return true;
    } # end migrate()

sub searchAndDestroy {
    my $searchCommand = $_[0];

    if( $opt_debug ) { print( $searchCommand . "\n" ); }
    my $listOfFiles = qx/$searchCommand/;
    if( ! defined( $listOfFiles ) ) {
        print( STDERR "Command '$searchCommand' failed: $!\n" );
        return false;
        }

    my @arrayOfFiles = split( "\0", $listOfFiles );
    if( $opt_debug ) { print( join( " ", @arrayOfFiles ) . "\n" ); }
    my $numUnlinked = unlink( @arrayOfFiles );
    if( $numUnlinked != ($#arrayOfFiles + 1) ) {
        print( STDERR "Failed to unlink some files ($numUnlinked / $#arrayOfFiles OK): $!\n" );
        return false;
        }

    return true;
    } # end searchAndDestroy

sub clean {
    my $row = $_[0];
    
    # Make sure the run isn't archived.
    if( defined( $row->{ 'archive_results_until' } ) ) {
        # FIXME: check for expired pins.
        if( $opt_debug ) { print( "Not cleaning pinned run $row->{ 'gid' }\n" ); }
        return false;
        }

    if( $row->{ 'archived' } == 0 && ! $opt_force_clean ) {
        if( $opt_debug ) { print( "Not cleaning cleaned run $row->{ 'gid' }\n" ); }
        return false;
        }
        
    print( "Cleaning run $row->{ 'gid' }...\n" );

    # If we really wanted to be special, we could clean a run by copying
    # only parts of it that we want to another directory and then
    # updating the directory and the cleaned bit in the database.
    # However, I don't think we actually care if we clean a run more than
    # once, so I'll just clean the run and then update the database.
    # If we get interrupted part of the way through, well, we'll catch
    # this run the next time.  (Since the 'archived' bit is never exposed
    # to the user... right?)
    my $fullPath = $row->{ 'filepath' } . "/" . $row->{ 'gid' };
    
    # OK, that sounded simple, but we don't want to mark the run as cleaned
    # if the commands fail for some reason.  We should also spit out an
    # error message so the admin can do something sane.
    my $findAllTarballs = qq#find $fullPath -name '*.tar.gz' -print0#;
    my $findNonLogs = qq#find $fullPath/userdir -mindepth 2 #;
      $findNonLogs .= qq#-type f #;
      $findNonLogs .= qq#-not -iname '*.err' #;
      $findNonLogs .= qq#-not -iname '*.out' #;
      $findNonLogs .= qq#-print0#;

    # To avoid hitting the filesystem, use qx//.  You can't use the list
    # context, because it can't distinguish between a failure and a succesful
    # find of nothing.

    return false unless searchAndDestroy( $findAllTarballs );
    return false unless searchAndDestroy( $findNonLogs );
        
    my $query = qq/UPDATE $NmiDatabaseVariables::DB_TABLE_RUN /;
    $query .= qq/SET archived = 0 WHERE gid = '$row->{ 'gid' }'/;
    if( $opt_debug ) { print( $query . "\n" ); }
    if( ! NmiDatabase::get_db()->do( $query ) ) {
        print( STDERR "Query '$query' failed: '${DBI::errstr}'\n" );
        return false;
        }

    return true;
    } # end clean()

##
## Functions 
##

sub usage {
    print( "Usage: $0 --percentage p --source-host s
                      clean || migrate --target-host t
                      <options>

where 'p' is the target percentage of disk space /used/,
      's' is the FQDN of the current host (laziness on my part),
  and 't' is the FQDN of the target host.

The commands include:
    migrate         Migrate runs to free disk space.
    clean           Clean runs to free disk space.
    no-op           Perform no action.  Useful with --debug.

Options may be unambigously abbreviated:
    --help          Print this help.
    --nmiconf       Use the specified Metronome configuration file.
    --debug         Print debugging information.

    --space-dir     Use the specified directory to calculate disk usage.
                    Defaults to the configured run directory.
                    NOTE: this has no effect on which runs are transferred.
    --target-dir    Transfer runs into the specified remote directory.
    --notify        Send e-mail about the migration process to this address.
                    NOTE: Not implemented.
    --date-limit    Don't act on runs from after this date.
    --force-clean   Clean runs already marked as cleaned.
    --start-limit   Don't act on runs from before this date.
    --only          Specify a single runid, GID, or directory to act on.
    --directory     Specify the directory containing 'nmi_migrate_run'.
" );
    exit $_[0];
    } # end usage()

sub findPercentageSpaceUsed {
    my $path = $_[0];
    my $free = `df -B M $path | grep -v blocks | head -1 | awk '{print \$5}' | sed -e s/%//`;
    chomp( $free );
    return $free;
    } # end free_disk_space()


# FIXME: yoinked from disk_tool.pl; should be in a module.
sub getQueryResults {
    my $query = $_[0];
    my $handle = NmiDatabase::execute( $query );
    my @rows;
    while( my $row = $handle->fetchrow_hashref() ) {
        push( @rows, $row );
        }
    $handle->finish();
    return @rows;
    }

# FIXME: yoinked from disk_tool.pl; should be in a module.
sub getRuns {
    my( $query, $host ) = @_;
    if( defined( $host ) ) {
        $query .= qq/ AND host = '$host'/;
        }
    if( $opt_debug ) {
        print( $query . "\n" );
        }
    return getQueryResults( $query );
    }

