Subversion Repositories DevTools

Rev

Rev 7539 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

#! /usr/bin/perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : blatQuarantine.pl
# Module type   :
# Compiler(s)   : Perl
# Environment(s):
#
# Description   : Age outpackages from dpkg_archive
#                 A replacement for the original quarantine process
#
# Usage         :   ARGV[0] - Path to config file for this instance
#
#! /usr/bin/perl
#......................................................................#

require 5.008_002;
use strict;
use warnings;
use Getopt::Long;
use File::Basename;
use Data::Dumper;
use File::Spec::Functions;
use POSIX ":sys_wait_h";
use File::Temp qw/tempfile/;
#use Digest::MD5 qw(md5_base64 md5_hex);
#use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

use FindBin;                                    # Determine the current directory
use lib "$FindBin::Bin/lib";                    # Allow local libraries

use Utils;
use StdLogger;                                  # Log to sdtout
use Logger;                                     # Log to file

#
#   Database interface
#   Pinched from jats and modified so that this software is not dependent on JATS
#
use IO::Handle;
use JatsRmApi;
use DBI;

#
#   Globals
#
my $logger = StdLogger->new();                  # Stdout logger. Only during config
$logger->err("No config file specified") unless (defined $ARGV[0]);
$logger->err("Config File does not exist: $ARGV[0]") unless (-f $ARGV[0]);
my $name = basename( $ARGV[0]);
   $name =~ s~.conf$~~;
my $now = 0;
my $startTime = 0;
my $nextQScan = 0;
my $lastS3Refresh =  0;
my $lastTagListUpdate = 0;
my $mtimeConfig = 0;
my $conf;
my $yday = -1;
my $linkUp = 1;
my $dbUp = 1;
my $RM_DB;
my $DM_DB;
my $activeReleases;
my $RMerror = 0;                        # Error on last RM DB access
my $ignorePkg;                          # Ref to hash of packages to ignore
my $explainFh;                          # Per quarantine info

#
#   Contain statisics maintained while operating
#       Can be dumped with a kill -USR2
#       List here for documentation
#  

my %statistics = (
    SeqNum => 0,                        # Bumped when $statistics are dumped
    timeStamp => 0,                     # DateTime when statistics are dumped
    upTime => 0,                        # Seconds since program start
    Cycle => 0,                         # Major process loop counter
    phase => 'Init',                    # Current phase of operation
    state => 'OK',                      # Nagios state
    wedged => 0,                        # Wedge indication - main loop not cycling
                                        # 
                                        # The following are reset each day
    dayStart => 0,                      # DateTime when daily data was reset
    linkErrors => 0,                    # Transfer (S3) errors
    dbErrors => 0,                      # Database errors
    processLoops => 0,                  # Number of time the quarantine process was run
    QuarantineCount => 0,               # Packages quarantined today
    QuarantineTxRequested => 0,         # Requests for transfer to S3 (unexpected)
    QuarantineError => 0,               # Errors encountered today
    
);

#
#   Stats gatthered during the quarantine process
#   Held in a seperate structure to simplify handling
#   Per Cycle Data - Calculated each processing Cycle
#   
my %qStats = (
    # Error counters
    QuarantineError         => 0,

    # Major Statistics
    Quarantine              => 0,                       # Total packages to be quarantined
    QuarantineCount         => 0,                       # Packages quarantined in this cycle
    QuarantineTxRequested   => 0,                       # Requests for transfer to S3 (unexpected)
    QuarantineToDo          => 0,                       # Remaining to be processed

    # Minor Statistics
    #   Reasons that packages are retained
    ReasonFileNotInReleaseManager => 0,
    ReasonInDeploymentManager     => 0,
    ReasonInSdk                   => 0,
    ReasonIsPatch                 => 0,
    ReasonManualBuild             => 0,
    ReasonRetainTime              => 0,
    ReasonNoBuildStandard         => 0,
    ReasonNoPackageEntry          => 0,
    ReasonNoPVid                  => 0,
    ReasonNotInArchive            => 0,
    ReasonNotInReleaseManager     => 0,
    ReasonNotLocked               => 0,
    ReasonSecondLevelPackage      => 0,
    ReasonTopLevelPackage         => 0,
    ReasonTotalPackages           => 0,

    DpkgPackageCount        => 0,                       # Number of packages in dpkg_archive
    DpkgArchiveCount        => 0,                       # Number of package-versions in dpkg_archive
    ReleaseCount            => 0,                       # Number of releases to process
    RmPackageCount          => 0,                       # Number of packages extracted from RM
    TopLevelCount           => 0,                       # Number of top level packages extracted from RM
    DmPackageCount          => 0,                       # Number of packages from Recent DM SBoms
    SdkCount                => 0,                       # Number of packages in SDKs 
    StrayCount              => 0,                       # Number of stray packages discovered
);

#
#   Describe configuration parameters
#
my %cdata = (
    '.ignore'         => {'pkg\.(.+)' => 'pkgs' },

    'piddir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
    'sleep'           => {'default'   => 5      , 'fmt' => 'period'},
    'sleepLinkDown'   => {'default'   => '1m'   , 'fmt' => 'period'},
    'dpkg_archive'    => {'mandatory' => 1      , 'fmt' => 'dir'},
    'logfile'         => {'mandatory' => 1      , 'fmt' => 'vfile'},
    'logfile.size'    => {'default'   => '1M'   , 'fmt' => 'size'},
    'logfile.count'   => {'default'   => 9      , 'fmt' => 'int'},
    'wedgeTime'       => {'default'   => '120m'  , 'fmt' => 'period'},              # Can take a long time to process

    'verbose'         => {'default'   => 0      , 'fmt' => 'int'},                  # Debug ...
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},                 # Disable alltogether
    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},                 # Show transfer times
    'noTransfers'     => {'default'   => 0      , 'fmt' => 'bool'},                 # Debugging option to prevent transfers

    'test'            => {'default'   => 0      , 'fmt' => 'bool'},                 # Used to test parts of the code

    'tagdir'          => {'mandatory' => 1      , 'fmt' => 'mkdir'},

    'runTime'         => {'default' => undef    , 'fmt' => 'period'},               # Time after midnight to run the quarantine process
    'forcedirscan'    => {'default'   => '24h'  , 'fmt' => 'period'},               # Period to run quantine scan

    'forces3update'   => {'default'   => '30m'  , 'fmt' => 'period'},
    'tagListUpdate'   => {'default'   => '1h'   , 'fmt' => 'period'},
    'S3Bucket'        => {'mandatory' => 1      , 'fmt' => 'text'},
    'S3Profile'       => {'mandatory' => 1      , 'fmt' => 'text'},
    'S3Region'        => {'default' => undef    , 'fmt' => 'text'},

    'snapAge'         => {'default'   => '1'    , 'fmt' => 'int'},                  # Days not a time
    'retainNoRm'      => {'default'   => '31d'  , 'fmt' => 'period'},
    'retain'          => {'default'   => '10d'  , 'fmt' => 'period'},

    'explain'         => {'default'   => 1      , 'fmt' => 'bool'},
);


#
#   Read in the configuration
#       Set up a logger
#       Write a pidfile - thats not used
$now = $startTime = time();
readConfig();
Utils::writepid($conf);
$logger->logmsg("Starting...");
readStatistics();
sighandlers();
$nextQScan = setQuarantineRunTime(0);

#
#   Main processing loop
#   Will exit when terminated by parent
#
while (1)
{
    $logger->verbose3("Processing");
    $statistics{Cycle}++;
    $now = time();
    Utils::resetWedge();

    $statistics{phase} = 'ReadConfig';
    readConfig();
    if ( $conf->{'active'} )
    {
        $statistics{phase} = 'Refresh S3 Info';
        refreshS3Info();
        if( $linkUp )
        {
            $statistics{phase} = 'Process Packages';
            processPackages();

            $statistics{phase} = 'maintainTagList';
            maintainTagList();
        }
    }

    $statistics{phase} = 'Sleep';
    sleep( ($linkUp && $dbUp) ? $conf->{'sleep'} : $conf->{'sleepLinkDown'} );
    reapChildren();

    #   If my PID file ceases to be, then exit the daemon
    #   Used to force daemon to restart
    #
    unless ( -f $conf->{'pidfile'} )
    {
        $logger->logmsg("Terminate. Pid file removed");
        last;
    }
}
$statistics{phase} = 'Terminated';
$logger->logmsg("Child End");
exit 0;

#-------------------------------------------------------------------------------
# Function        : reapChildren 
#
# Description     : Reap any and all dead children
#                   Call in major loops to prevent zombies accumulating 
#
# Inputs          : None
#
# Returns         : 
#
sub reapChildren
{
    my $currentPhase = $statistics{phase};
    $statistics{phase} = 'Reaping';

    my $kid;
    do {
        $kid = waitpid(-1, WNOHANG);
    } while ( $kid > 0 );

    $statistics{phase} = $currentPhase;
}


#-------------------------------------------------------------------------------
# Function        : readConfig
#
# Description     : Re read the config file if it modification time has changed
#
# Inputs          : Nothing
#
# Returns         : 0       - Config not read
#                   1       - Config read
#                             Config file has changed
#
sub readConfig
{
    my ($mtime) = Utils::mtime($ARGV[0]);
    my $rv = 0;

    if ( $mtimeConfig != $mtime )
    {
        $logger->logmsg("Reading config file: $ARGV[0]");
        $mtimeConfig = $mtime;
        my $errors;
        ($conf, $errors) = Utils::readconf ( $ARGV[0], \%cdata );
        if ( scalar @{$errors} > 0 )
        {
            warn "$_\n" foreach (@{$errors});
            die ("Config contained errors\n");
        }

        #
        #   Reset some information
        #   Create a new logger
        #
        $logger = Logger->new($conf) unless $conf->{debug};
        $conf->{logger} = $logger;
        $conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';
        $logger->setVerbose($conf->{verbose});
        $logger->verbose("Log Levl: $conf->{verbose}");

        #
        #   Setup statistics filename
        $conf->{'statsfile'} = $conf->{'piddir'} . '/' . $name . '.stats';
        $conf->{'statsfiletmp'} = $conf->{'piddir'} . '/' . $name . '.stats.tmp';

        #
        #   Process 'pkgs' entry and set up $ignorePkg
        #
        $ignorePkg = {};
        while (my($key, $data) = each ( %{$conf->{pkgs}} ))
        {
            if ( $data eq 'KEEP' ) {
                $ignorePkg->{$key} = 1;
                $logger->verbose("Keep Pkg: $key");

            } else {
                $logger->warn("Unknown pkg mode: $key, $data");
            }
        }

        #
        #   When config is read force some actions
        #       - Force tagList to be created
        #       - Force refresh from S3
        $lastTagListUpdate = 0;
        $lastS3Refresh = 0;
        $rv = 1;

        #
        #   When config is read force some actions
#Utils::DebugDumpData ("Config", $conf);

        $logger->warn("All Transfers disabled") if ( $conf->{'noTransfers'} );
        $logger->warn("Package quarantine is inactive") unless ( $conf->{'active'} );
        $logger->warn("TEST MODE") if ( $conf->{'test'} );
    }

    return $rv;
}

#-------------------------------------------------------------------------------
# Function        : refreshS3Info 
#
# Description     : At startup, and at time after startup examine the S3 bucket
#                   and recover information from it 
#
# Inputs          : 
#
# Returns         : 0 - Gross error ( Bucket access) 
#
sub refreshS3Info
{
    my $rv = 1;
    if ( !$linkUp || ($now > ($lastS3Refresh + $conf->{'forces3update'})) )
    {
        $logger->verbose("refreshS3Info");
        $lastS3Refresh = $now;

        #
        #   Examine the s3 bucket and extract useful information
        #
        my $startTime = time;
        $rv =  examineS3Bucket();
         unless ($rv) {
            $statistics{linkErrors}++;
            $linkUp = 0;
         } else {
             $linkUp = 1;
         }

         #
         #   Display the duration of the refresh
         #       Diagnostic use
         #
         if ($conf->{txdetail}) {
             my $duration = time - $startTime;
             $logger->logmsg("refreshS3Info: Stats: $duration Secs");
         }

    }
    return $rv;
}

#-------------------------------------------------------------------------------
# Function        : examineS3Bucket 
#
# Description     : Scan the S3 bucket
#                   Currently only validates that the bucket exist
#                   and that the link is up.     
#                       
# Inputs          : Nothing 
#
# Returns         : 0 - Gross error ( Bucket access) 
#
sub examineS3Bucket
{
    my $bucket;
    my $prefix;

    if ($conf->{'S3Bucket'} =~ m~(.*?)/(.*)~) {
        $bucket = $1;
        $prefix = $2;
    } else {
        $bucket = $conf->{'S3Bucket'};
    }

    my $s3_cmd = "aws --profile $conf->{'S3Profile'} --output json";
    $s3_cmd .= " --region $conf->{'S3Region'}" if (defined $conf->{'S3Region'});
    $s3_cmd .= " s3api head-bucket --bucket $bucket";

    $logger->verbose2("examineS3Bucket:s3_cmd:$s3_cmd");

    my $ph;
    my $jsontxt = "";
    open ($ph, "$s3_cmd 2>&1 |");
    while ( <$ph> ) {
        chomp;
        $logger->verbose3("examineS3Bucket:Data: $_");
    }
    close ($ph);
    my $cmdRv = $?;
    if ($cmdRv != 0) {
        $logger->warn("Cannot read S3 Bucket Data");
        return 0;
    }

#Utils::DebugDumpData("activeReleases",$activeReleases);
    return 1;
}

#-------------------------------------------------------------------------------
# Function        : processPackages
#
# Description     : Process packages - the bulk of the quarantine effort
#                   This is simply time based
#
# Inputs          : None
#
# Returns         : Nothing
#
sub processPackages
{
    #
    #   Determine if new tags are present by examining the time
    #   that the directory was last modified.
    #
    #   Allow for a forced scan to catch packages that did not transfer
    #   on the first attempt
    #
    if ($now > $nextQScan)
    {
        $logger->verbose2("processPackages");
        $statistics{processLoops}++;
        resetData(1);


        my $fileExplain = $conf->{tagdir} . '/explain.txt';
        open ($explainFh, '>', $fileExplain);

        connectRM(\$RM_DB);
        connectDM(\$DM_DB);
        getReleaseDetails();
        GetAllPackageData();
        getTopLevelPackages();
        GetRecentDMPackages();
        LocateStrays();
        GetSdkPackageData();
        disconnectDM(\$DM_DB);
        disconnectRM(\$RM_DB);

        DumpInternalData();
        GeneratePvidLookup();
        processDpkgArchive();

        calcPkgsToQuarantine();
        doQuarantine();

#        reportMissingPkgs();
#        reportStats();
        close $explainFh;
        resetData(0);

        #
        #   Reset the scan time triggers
        #   
        $nextQScan = setQuarantineRunTime(1);
    }
}

#-------------------------------------------------------------------------------
# Function        : getDataFromRm 
#
# Description     : Get an array of data from RM
#                   Normally an array of arrays 
#
# Inputs          : $name           - Query Name
#                   $m_sqlstr       - Query
#                   $options        - Ref to a hash of options
#                                       sql     - show sql
#                                       data    - show data
#                                       dump    - show results
#                                       oneRow  - Only fetch one row
#                                       error   - Must find data
#                                       
# Returns         : ref to array of data
#
sub getDataFromRm
{
    my ($name,$m_sqlstr, $options ) = @_;
    my @row;
    my $data;
    $RMerror = 0;

    if (ref $options ne 'HASH') {
        $options = {}; 
    }

    if ($options->{sql}) {
        $logger->logmsg("$name: $m_sqlstr")
    }
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) ) {
            if ( $sth->rows ) {
                while ( @row = $sth->fetchrow_array ) {
                    if ($options->{data}) {
                        $logger->warn ("$name: @row");
                    }
                    #Debug0("$name: @row");
                    push @{$data}, [@row];

                    last if $options->{oneRow};
                }
            }
            $sth->finish();
        } else {
            $logger->warn("Execute failure:$name: $m_sqlstr", $sth->errstr() );
            $RMerror++;
            $statistics{dbErrors}++;
        }
    } else {
        $logger->warn("Prepare failure:$name" );
        $RMerror++;
        $statistics{dbErrors}++;
    }

    if (!$data && $options->{error}) {
        $logger->warn( $options->{error} );
    }

    if ($data && $options->{oneRow}) {
        $data = $data->[0];
    }
 
    if ($options->{dump}) {
        Utils::DebugDumpData("$name", $data);
    }
    return $data;
}

#-------------------------------------------------------------------------------
# Function        : executeRmQuery 
#
# Description     : Execute a simple RM query. One that does not expect any return data
#                   Assume DB connection has been established    
#
# Inputs          : $fname           - OprName, for error reporting
#                   $m_sqlstr        - SQL String
#
# Returns         : 1 - on Error
#                   0 - All good
#               
#
sub executeRmQuery
{
    my ($fname, $m_sqlstr) = @_;

    $logger->verbose3('ExecuteQuery:', $fname);
    $RMerror = 0;
    #
    #   Create the full SQL statement
    #
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute() )
        {
            $sth->finish();
        }
        else
        {
            $logger->warn("$fname: Execute failure: $m_sqlstr", $sth->errstr() );
            $RMerror++;
            $statistics{dbErrors}++;
            return 1;
        }
    }
    else
    {
        $logger->warn("$fname: Prepare failure");
        $RMerror++;
        $statistics{dbErrors}++;
        return 1;
    }

    return 0;
}

#-------------------------------------------------------------------------------
# Function        : maintainTagList
#
# Description     : Maintain a data structure for the maintenance of the
#                   tags directory
#
# Inputs          : None
#
# Returns         : Nothing
#
sub maintainTagList
{
    #
    #   Time to perform the scan
    #   Will do at startup and every time period there after
    #
    return unless ( $now > ($lastTagListUpdate + $conf->{tagListUpdate} ));
    $logger->verbose("maintainTagList");
    $lastTagListUpdate = $now;

    #
    #   Generate new configuration
    #
    my %config;
    $config{s3Manifest} = 1;                # Indicate that it may be special

    %{$config{releases}} = map { $_ => 1 } keys %{$activeReleases};

    #
    #   Save data
    #
    my $dump =  Data::Dumper->new([\%config], [qw(*config)]);
#print $dump->Dump;
#$dump->Reset;

    #
    #   Save config data
    #
    my $conf_file = catfile( $conf->{'tagdir'},'.config' );
    $logger->verbose3("maintainTagList: Writting $conf_file");

    my $fh;
    open ( $fh, '>', $conf_file ) or $logger->err("Can't create $conf_file: $!");
    print $fh $dump->Dump;
    close $fh;
}

#-------------------------------------------------------------------------------
# Function        : resetDailyStatistics 
#
# Description     : Called periodically to reset the daily statistics
#
# Inputs          : $time       - Current time
#
# Returns         : 
#
sub resetDailyStatistics
{
    my ($time) = @_;

    #
    #   Detect a new day
    #
    my $today = (localtime($time))[7];
    if ($yday != $today)
    {
        $yday = $today;
        $logger->logmsg('Resetting daily statistics' );

        # Note: Must match @recoverTags in readStatistics
        $statistics{dayStart} = $time;
        $statistics{linkErrors} = 0;
        $statistics{dbErrors} = 0;
        $statistics{processLoops} = 0;
        $statistics{QuarantineCount} = 0;
        $statistics{QuarantineTxRequested} = 0;
        $statistics{QuarantineError} = 0;
    }
}

#-------------------------------------------------------------------------------
# Function        : readStatistics 
#
# Description     : Read in the last set of stats
#                   Used after a restart to recover daily statistics
#
# Inputs          : 
#
# Returns         : 
#
sub readStatistics
{
    my @recoverTags = qw(dayStart linkErrors dbErrors processLoops QuarantineCount QuarantineTxRequested QuarantineError);

    if ($conf->{'statsfile'} and -f $conf->{'statsfile'})
    {
        if (open my $fh, $conf->{'statsfile'})
        {
            while (<$fh>)
            {
                m~(.*):(.*)~;
                if ( grep( /^$1$/, @recoverTags ) ) 
                {
                    $statistics{$1} = $2;
                    $logger->verbose("readStatistics $1, $2");
                }
            }
            close $fh;
            $yday = (localtime($statistics{dayStart}))[7];
        }
    }
}


#-------------------------------------------------------------------------------
# Function        : periodicStatistics 
#
# Description     : Called on a regular basis to write out statistics
#                   Used to feed information into Nagios
#                   
#                   This function is called via an alarm and may be outside the normal
#                   processing loop. Don't make assumptions on the value of $now
#
# Inputs          : 
#
# Returns         : 
#
sub periodicStatistics
{
    #
    #   A few local stats
    #
    $statistics{SeqNum}++;
    $statistics{timeStamp} = time();
    $statistics{upTime} = $statistics{timeStamp} - $startTime;
    $statistics{wedged} = Utils::isWedged($conf);

    if ( $statistics{wedged}) {
         $statistics{state} = 'Wedged';
    } elsif(!$dbUp){
        $statistics{state} = 'RM Access error';
    } elsif(!$linkUp){
        $statistics{state} = 'S3 Bucket Read Error';
    } elsif($statistics{QuarantineError}){
        $statistics{state} = 'Error quarantining a package';
    } else {
        $statistics{state} = 'OK';
    }


    #   Reset daily accumulations - on first use each day
    resetDailyStatistics($statistics{timeStamp});
    
    #
    #   Write statistics to a file
    #       Write to a tmp file, then rename.
    #       Attempt to make the operation atomic - so that the file consumer
    #       doesn't get a badly formed file.
    #   
    if ($conf->{'statsfiletmp'})
    {
        my $fh;
        unless (open ($fh, '>', $conf->{'statsfiletmp'}))
        {
            $fh = undef;
            $logger->warn("Cannot create temp stats file: $!");
        }
        else
        {
            foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)
            {
                print $fh $key . ':' . $statistics{$key} . "\n";
                $logger->verbose2('Statistics:'. $key . ':' . $statistics{$key});
            }

            #
            #   Also dump the stats related to the current (last)
            #   
            foreach my $key ( sort { lc($a) cmp lc($b) } keys %qStats)
            {
                my $txt = 'Qstats' . $key . ':' . $qStats{$key};
                print $fh  $txt . "\n";
                $logger->verbose2('Statistics:'. $txt);
            }
            #

            close $fh;

            # Rename temp to real file
            rename  $conf->{'statsfiletmp'},  $conf->{'statsfile'} ;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : sighandlers
#
# Description     : Install signal handlers
#
# Inputs          : Uses gobals
#
# Returns         : Nothing
#
sub sighandlers
{
    $SIG{TERM} = sub {
        # On shutdown
        $logger->logmsg('Received SIGTERM. Shutting down....' );
        unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});
        exit 0;
    };

    $SIG{HUP} = sub {
        # On logrotate
        $logger->logmsg('Received SIGHUP.');
        $logger->rotatelog();
    };

    $SIG{USR1} = sub {
        # On Force Rescans
        $logger->logmsg('Received SIGUSR1.');
        $lastTagListUpdate = 0;
        $lastS3Refresh = 0;
        $nextQScan = 0;
    };

    alarm 60;
    $SIG{ALRM} = sub {
        # On Dump Statistics
        $logger->verbose2('Received SIGUSR2.');
        periodicStatistics();
        alarm 60;
    };

    $SIG{__WARN__} = sub { $logger->warn("@_") };
    $SIG{__DIE__} = sub { $logger->err("@_") };
}


#-------------------------------------------------------------------------------
# Function        : Error, Verbose, Warning
#
# Description     : Support for JatsRmApi
#
# Inputs          : Message
#
# Returns         : Nothing
#
sub Error
{
    $logger->err("@_");
}

sub Verbose
{
    $logger->verbose2("@_");
}

sub Warning
{
    $logger->warn("@_");
}

###############################################################################
#
#   Quarintine specific bits
#   
my @quarantineItems;
my @StrayPackages;

our %Releases;
our %Packages;
my %pkgPvid;

#-------------------------------------------------------------------------------
# Function        : resetData 
#
# Description     : Delete all the collected data so that we can run the process
#                   again 
#
# Inputs          : mode    - true. Reset quarantine stats too 
#
# Returns         : 
#
sub resetData
{
    my ($mode) = @_;

    @quarantineItems = ();
    @StrayPackages = ();
    %Releases = ();
    %Packages = ();
    %pkgPvid = ();

    if ($mode) {
        # Reset Stats for this run
        foreach my $key ( keys %qStats ) {
            $qStats{$key} = 0;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : setQuarantineRunTime 
#
# Description     : Set the runtime for the next run of the quarantine process
#                   Can configure the time at which the process will run
#                   In this mode it will run once a day at the specified time
#
# Inputs          : $mode : True: Calc next time
# 
#                   From conf.
#                   runTime - Time past midnight to run the process
#                   forcedirscan - Delay to next run
#                    
#
# Returns         : Next time to run the quarantine 
#
sub setQuarantineRunTime
{
    my ($mode) = @_;
    my $nextRunTime;
    if (defined $conf->{runTime}) {
        #
        #   Calc midnight
        #
        my @time = localtime();
        my $secsSinceMidnight = ($time[2] * 3600) + ($time[1] * 60) + $time[0];
        my $midnight = time() - $secsSinceMidnight;
        if ($mode) {
            $midnight += 24*60*60;
        }
        
        #
        #   Calc next run time
        #   
        $nextRunTime =  $midnight + $conf->{runTime};
    } else {
        $nextRunTime = time() + $conf->{forcedirscan};
    }
    $logger->verbose("setQuarantineRunTime: $nextRunTime, (" . localtime($nextRunTime) . ")");
    return $nextRunTime;
}


#-------------------------------------------------------------------------------
# Function        : getReleaseDetails
#
# Description     : Determine all candiate releases
#                   Assume connected to database
#
# Inputs          : 
#
# Returns         : 
#
sub getReleaseDetails
{
    my (@row);

    $logger->verbose("Determine all Release Names");

    # Get all Releases
    # From non-archived releases
    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official, TRUNC (SYSDATE - rt.official_stamp) as OFFICIAL_STAMP_DAYS, TRUNC (SYSDATE - rt.created_stamp) as CREATED_STAMP_DAYS" .
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
                   "   AND rt.official != 'A' ORDER BY UPPER(prj.PROJ_NAME), UPPER(rt.RTAG_NAME)";
#                   "   AND rt.official != 'Y'" .

    $logger->verbose2("getReleaseDetails: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $rtag_id =$row[3];
                    my $proj_id = $row[2];
                    my $official = $row[4];
                    my $age = defined($row[5]) ? $row[5] : $row[6];

                    # Only retain recent snapshot
                    if ($official eq 'S' && $age > $conf->{snapAge}) {
                        next;
                    }
                    
#if ( $official eq 'Y' ) {
#    Information("Closed Age ($proj_id) : $age : $row[0], $row[1]");
#}
#                    if ( $official eq 'Y' && $age && $age > 300 )
#                    {
#                        next;
#                    }

                    $Releases{$rtag_id}{pName} = $row[0];
                    $Releases{$rtag_id}{name} = $row[1];
                    $Releases{$rtag_id}{proj_id} = $proj_id;
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
                    $Releases{$rtag_id}{official} = $row[4];
                    $Releases{$rtag_id}{officialDays} = defined($row[5]) ? $row[5] : $row[6] ;
                    $Releases{$rtag_id}{createdDays} = $row[6];

                    #print join (',',@row), "\n" if ($opt_verbose > 2);
                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("getReleaseDetails:Prepare failure" );
    }

    $qStats{ReleaseCount} = scalar keys %Releases;
}

#-------------------------------------------------------------------------------
# Function        : GetAllPackageData
#
# Description     : Extract all package data
#
# Inputs          : 
#
# Returns         : 
#

sub GetAllPackageData
{
    my (@row);
    my $count = 0;

    $logger->verbose ("Extract all package data");

    # First get all packages
    # From non-archived releases

    my $m_sqlstr = "SELECT DISTINCT " .
                        "pv.PV_ID, " .                                          #[0]
                        "pkg.PKG_NAME, " .                                      #[1]
                        "pv.PKG_VERSION, " .                                    #[2]
                        "pv.DLOCKED, " .                                        #[3]
                        "pv.PKG_ID," .                                          #[4]
                        "pv.is_patch," .                                        #[5]
                        "pv.build_type,".                                       #[6]
                        "pbi.bsa_id," .                                         #[7]
#                        "pv.CREATOR_ID, " .                                     #[8]
#                        "pv.MODIFIED_STAMP, " .                                 #[9]
#                        "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]
                        "999" .
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
                         "RELEASE_MANAGER.PACKAGES pkg,".
                         "release_manager.package_build_info pbi" .
                   " WHERE pv.PKG_ID = pkg.PKG_ID" .
                   "   AND pv.pv_id = pbi.pv_id(+)";

    $logger->verbose2("GetAllPackageData: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    #print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                        $Packages{$pvid}{locked} = $row[3];
                        $Packages{$pvid}{pkgid} = $row[4];
                        $Packages{$pvid}{isPatch} = $row[5] || 0;
                        $Packages{$pvid}{buildType} = $row[6] || 0;
                        $Packages{$pvid}{buildStandard} = $row[7] || 0;

                        #$Packages{$pvid}{Creator} = $row[8];
                        #$Packages{$pvid}{Age} = $row[9];
                        #$Packages{$pvid}{vcstag} = $row[10];
                        
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("GetAllPackageData:Prepare failure" );
    }

    $logger->verbose ("All Packages: $count rows");
    $qStats{RmPackageCount} = $count;
}

#-------------------------------------------------------------------------------
# Function        : getTopLevelPackages
#
# Description     : Extract top level packages from active releases
#
# Inputs          : 
#
# Returns         : 
#

sub getTopLevelPackages
{
    my (@row);
    my $count = 0;

    $logger->verbose ("Extract toplevel dependencies");

    # First get all packages that are referenced in a Release
    # This will only get the top level packages
    # From non-archived releases

    my $m_sqlstr = "SELECT DISTINCT " .
                        "rc.PV_ID, " .                                          #[0]
                        "rt.RTAG_ID, " .                                        #[1]
                        "prj.PROJ_ID, " .                                       #[2]
                        "rt.official, " .                                       #[3]    
                        "TRUNC (SYSDATE - rt.official_stamp),".                 #[4]
                        "TRUNC (SYSDATE - rt.created_stamp)" .                  #[5]
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".
                         "release_manager.release_tags rt,".
                         "release_manager.projects prj" .
                   " WHERE prj.PROJ_ID = rt.PROJ_ID" .
                   "   and rt.RTAG_ID = rc.RTAG_ID" .
                   "   AND rt.official != 'A'";

    $logger->verbose2("getTopLevelPackages: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pvid = $row[0];
                    my $rtag_id = $row[1];
                    my $proj_id = $row[2];
                    my $official = $row[3];
                    my $age = defined($row[4]) ? $row[4] : $row[6];

                    # Only retain recent snapshot
                    if ($official eq 'S' && $age > $conf->{snapAge}) {
                        next;
                    }

                    $count++;
                    $Packages{$pvid}{tlp} = 1;
                    push @StrayPackages, $pvid;

                    push @{$Packages{$pvid}{release}}, $rtag_id;

                    push @{$Packages{$pvid}{projects}}, $proj_id
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});

                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("getTopLevelPackages:Prepare failure" );
    }

    $logger->verbose ("Extract toplevel dependencies: $count rows");
    $qStats{TopLevelCount} = $count;
}

#-------------------------------------------------------------------------------
# Function        : GetRecentDMPackages
#
# Description     : Extract Packages that referenced in Deployment Manager
#                   Want all package-versions from the last two BOMS in each state
#                   of all projects. 
#
# Inputs          : 
#
# Returns         : 
#

sub GetRecentDMPackages
{
    my (@row);
    my $count = 0;

    $logger->verbose ("Extract DM Packages");

    # Get all packages that are a part of a non-deprecated SDK
    # Only get the 'exposed' packages

    my $m_sqlstr =
        "SELECT DISTINCT pv.pv_id," .                         #[0]
        "  pkg.pkg_name," .                                   #[1]
        "  pv.pkg_version" .                                  #[2]
        " FROM DEPLOYMENT_MANAGER.bom_contents bc," .
        "     DEPLOYMENT_MANAGER.operating_systems os," .
        "     DEPLOYMENT_MANAGER.os_contents osc," .
        "     DEPLOYMENT_MANAGER.PACKAGES pkg," .
        "     DEPLOYMENT_MANAGER.PACKAGE_VERSIONS pv," .
        "     DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd" .
        " WHERE osc.os_id = os.os_id" .
        " AND os.node_id  = bc.node_id" .
        " AND bc.bom_id  IN" .
        "  (SELECT bom_id" .
        "  FROM" .
        "    (SELECT bs.bom_id, b.branch_id, state_id, bn.bom_name ," .
        "            RANK() OVER (PARTITION BY bs.state_id,b.branch_id, bn.bom_name ORDER BY bs.bom_id DESC) SRLNO" .
        "     FROM DEPLOYMENT_MANAGER.bom_state bs ," .
        "          DEPLOYMENT_MANAGER.boms b," .
        "          DEPLOYMENT_MANAGER.bom_names bn" .
        "     WHERE bs.bom_id   = b.bom_id" .
        "       AND b.BOM_NAME_ID = bn.BOM_NAME_ID" .
        "    )" .
        "  WHERE SRLNO <= 3" .
        "  )" .
        " AND pd.PROD_ID (+) = osc.PROD_ID" .
        " AND pv.pkg_id      = pkg.pkg_id" .
        " AND osc.prod_id    = pv.pv_id" .
        " ORDER BY UPPER(pkg.pkg_name), " .
        "          UPPER(pv.PKG_VERSION)";

    $logger->verbose2("GetRecentDMPackages: $m_sqlstr");
    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    #print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    $Packages{$pvid}{dm} = 1;
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                    }
                    push @StrayPackages, $pvid;
                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("GetRecentDMPackages:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("GetRecentDMPackages:Prepare failure" );
    }

    $logger->verbose ("Extract Deployed Packages: $count rows");
    $qStats{DmPackageCount} = $count;
}

#-------------------------------------------------------------------------------
# Function        : LocateStrays
#
# Description     : Locate stray packages
#                   Try to do several (200) at a time to speed up processing
#
# Inputs          :
#
# Returns         :
#
sub LocateStrays
{
    $logger->verbose  ("Locate indirectly referenced packages");
    my $count = 0;
    while ( $#StrayPackages >= 0 )
    {
        $logger->verbose3 ("Strays Remaining: " . scalar @StrayPackages );

        my @plist;
        while ( $#plist <= 200 && @StrayPackages )
        {
            my $pv_id = pop @StrayPackages;
            next if ( exists $Packages{$pv_id}{done} );
            push @plist, $pv_id;
        }

        GetDepends(@plist) if @plist;

        foreach ( @plist)
        {
            $Packages{$_}{done} = 1;
            $count++;
        }
    }

    $qStats{StrayCount} = $count;
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     :
#
# Inputs          : @plist          - list of pvid's to process
#
# Returns         :
#
sub GetDepends
{
    my (@plist) = @_;

    #
    #   Now extract the package dependacies
    #   There may not be any
    #
    my $m_sqlstr = "SELECT ".
                    " pd.PV_ID, ".
                    " pd.DPV_ID " .
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
                  " WHERE pd.PV_ID in ( " . join(',', @plist) . " )";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( my @row = $sth->fetchrow_array )
                {
                    my $pvid = $row[0];
                    my $dpvid = $row[1];
                    push @StrayPackages, $dpvid;
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
                    $Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};

                    #print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);
                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetSdkPackageData
#
# Description     : Extract Packages that are a part of a non-deprecated SDK
#                   Only want the exposed packages
#
#                   Don't care about the dependencies, so don't add them 
#                   to strays
#
# Inputs          : 
#
# Returns         : 
#

sub GetSdkPackageData
{
    my (@row);
    my $count = 0;

    $logger->verbose ("Extract SDK Packages");

    # Get all packages that are a part of a non-deprecated SDK
    # Only get the 'exposed' packages

    my $m_sqlstr = "SELECT sc.pv_id, " .                #[0]
                   "       p.PKG_NAME, " .              #[1]
                   "       pv.PKG_VERSION" .            #[2]
                   " FROM RELEASE_MANAGER.SDK_CONTENT sc," .
                   "   RELEASE_MANAGER.sdk_tags st," .
                   "   RELEASE_MANAGER.package_versions pv," .
                   "   RELEASE_MANAGER.PACKAGES p" .
                   " WHERE sc.SDKTAG_ID    = st.SDKTAG_ID" .
                   " AND p.PKG_ID = pv.PKG_ID" .
                   " AND pv.PV_ID = sc.pv_id" .
                   " AND sc.SDKPKG_STATE   = 'E'" .
                   " AND st.SDK_STATE NOT IN ('D')" ;

    $logger->verbose2("GetSdkPackageData: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $count++;
                    #print join (',',@row), "\n" if ($opt_verbose > 2);
                    my $pvid = $row[0];
                    $Packages{$pvid}{sdk} = 1;
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            $logger->warn("GetSdkPackageData:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        $logger->warn("GetSdkPackageData:Prepare failure" );
    }

    $logger->verbose ("Extract SDK Packages: $count rows");
    $qStats{SdkCount} = $count;
}

#-------------------------------------------------------------------------------
# Function        : GeneratePvidLookup  
#
# Description     : Populate $pkgPvid (hash)
#
# Inputs          : 
#
# Returns         : 
#
sub GeneratePvidLookup
{
    #
    # Create a lookup from package name/version to pvid
    #
    foreach my $pvid ( keys %Packages )
    {
        my $name = $Packages{$pvid}{name};
        my $version = $Packages{$pvid}{version};
        if ( $name && $version )
        {
            $pkgPvid{$name}{$version}{pvid} = $pvid;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : processDpkgArchive
#
# Description     : Scan dpkg_archive
#
# Inputs          : 
#
# Returns         : 
#
sub processDpkgArchive
{
    $logger->verbose ("Scanning dpkg_archive");
    unless (opendir( PKGS, $conf->{dpkg_archive} ) ) {
         $logger->warn("Cannot open dpkg_archive: $conf->{dpkg_archive}");
         return;
    }

    while ( my $pkgName = readdir(PKGS) )
    {
        next if ( $pkgName eq '.' );
        next if ( $pkgName eq '..' );
        next if ( $pkgName eq 'lost+found' );
        next if ( exists $ignorePkg->{$pkgName} );

        my $pkgDir = join('/', $conf->{dpkg_archive}, $pkgName );
        if ( -d $pkgDir )
        {
            if (opendir (PV, $pkgDir ) )
            {
                $qStats{DpkgPackageCount}++;
                while ( my $pkgVersion = readdir(PV) )
                {
                    next if ( $pkgVersion eq '.' );
                    next if ( $pkgVersion eq '..' );
                    next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)
                    $qStats{DpkgArchiveCount}++;

                    my $pkgPath = join('/', $conf->{dpkg_archive}, $pkgName,$pkgVersion );
                    my $mtime = checkTime($pkgPath);

                    my $pvid;
                    if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )
                    {
                        $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
                        $Packages{$pvid}{dpkg_archive} = 1;
                        $pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;
                    }
                    else
                    {
                        #
                        #   Package is in dpkg-archive, but not in Release
                        #   Manager. Allow for a short while
                        #
                        $qStats{ReasonTotalPackages}++;
                        $qStats{'Reason' . 'NotInReleaseManager'}++;
                        if ( $mtime > $conf->{retainNoRm} )
                        {
                            #Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");
                            quarantineItem( 'X', $pkgName, $pkgVersion );
                        }

                        explain ("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");
                    }

#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");
                }
                close(PV);
            }
        }
        elsif ( -f $pkgDir )
        {
            $logger->warn("Unexpected file in dpkg_archive: $pkgName");

            # Ideally we should delete the file
#            quarantineItem( 'F', -1, $pkgDir );
            $qStats{'Reason' .'FileNotInReleaseManager'}++;
            explain("Reason:-, $pkgDir, -, Reason:FileNotInReleaseManager");
        }
        else
        {
            $logger->warn("Unexpected entry in dpkg_archive: $pkgName");
        }
    }
    close(PKGS);
}

#-------------------------------------------------------------------------------
# Function        : calcPkgsToQuarantine 
#
# Description     : Calculate the packages to be quarantined 
#
# Inputs          : 
#
# Returns         : 
#
sub calcPkgsToQuarantine
{
    #
    #
    #   Scan all packages found in dpkg_archive and see if we should keep it
    #   Quarantine those we cannot find a reason to keep
    #
    foreach my $pkgName ( sort keys %pkgPvid )
    {
        foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )
        {
            my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} || 0;
            my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};
            my $keepReason = '';
            my $entry = $Packages{$pvid};

            {
                # Examine entry. Determine a reason to keep the package
                #   Some reasons to keep a package are no longer needed now that versions are pumped into S3

                unless ($entry) { $keepReason ='NoPackageEntry'; last;}
                unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}
                unless ($pvid) { $keepReason = 'NoPVid'; last;}
                if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}
                if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}
                if (exists $entry->{sdk}) { $keepReason ='InSdk'; last;}
                if (exists $entry->{dm}) { $keepReason = 'InDeploymentManager'; last;}
                if ($entry->{isPatch}) { $keepReason = 'IsPatch'; last;}
                if ($mtime <= $conf->{retain}) { $keepReason ='RetainTime:' . ($conf->{retain} - $mtime); last;}
                #unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}
                if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}
                #if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}

                $pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;
            }

            unless ( $keepReason )
            {
                $logger->verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");
                quarantineItem( 'Q', $mtime, $pkgName, $pkgVersion) ;
                $keepReason = 'Quarantine';
            }

            explain("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");

            #
            #   Maintain Stats
            #       Only use the Base Reason - remove details after the ':' character
            #
            my $sReason = $keepReason;
            $sReason =~ s~:.*$~~;
            $qStats{'Reason' . $sReason}++;
            $qStats{ReasonTotalPackages}++;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : quarantineItem
#
# Description     : Add item to the list of stuff to be quarantined
#
# Inputs          : $reason         - Reason
#                   $age            - Age
#                   $pkgName        - Package Nname
#                   $pkgVersion     - Package Version
#
# Returns         : 
#
sub quarantineItem
{
    my ($reason, $age, $pkgName, $pkgVersion ) = @_;
    my %data;
    $data{reason} = $reason;
    $data{age} = $age ;
    $data{name} = $pkgName;
    $data{version} = $pkgVersion;

    push @quarantineItems, \%data;
    $qStats{'Quarantine'}++;
}

#-------------------------------------------------------------------------------
# Function        : checkTime
#
# Description     : Seconds since modification of a path
#
# Inputs          : Path elements
#
# Returns         : Days since modification
#

sub checkTime
{
    my ($path) = @_;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);

    unless(defined $mtime)
    {
        $logger->warn("Bad stat for $path");
        $mtime = 0;
    }

    return $now - $mtime;
}
#-------------------------------------------------------------------------------
# Function        : DumpInternalData
#
# Description     : Save data for examination
#                   Has out of memory issues 
#
# Inputs          : 
#
# Returns         : 
#
sub DumpInternalData
{
#       my $fh;
#       my $fileName = $conf->{tagdir} . '/releases.txt';
#       $logger->logmsg("Dump Releases: $fileName");
#       open ($fh, '>', $fileName);
#       print $fh Data::Dumper->Dump ( [\%Releases] );
#       close $fh;
#
#       $fileName = $conf->{tagdir} . '/packages.txt';
#       $logger->logmsg("Dump Packages: $fileName");
#       open ($fh, '>', $fileName);
#       print $fh Data::Dumper->Dump ( [\%Packages] );
#       close $fh;
}

#-------------------------------------------------------------------------------
# Function        : doQuarantine
#
# Description     : Quarantine files and folders that have been queued up
#                   If the tar zip of the package exists in the s3 bucket - then delete it
#                   Otherwise request that a tar zip be created. Should be picked up on the
#                   next scan.
#
# Inputs          : None
#
# Returns         : 
#
sub doQuarantine
{
    my $testMsg = $conf->{test} ? 'Test,' : '';

    # Process entries - oldest first
    #
    $qStats{'QuarantineToDo'} = ( scalar @quarantineItems );
    $logger->logmsg ("Packages to quarantine:  $qStats{'QuarantineToDo'}");
    foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)
    {
        my $emsg = '';
        if (pkgInS3($entry->{name}, $entry->{version}) ) {
            #   Package is safely in S3 - can simply delete it
            if ($conf->{test}) {
                $emsg = ' - Not deleted in test mode';
                $qStats{'QuarantineCount'}++;      
                $statistics{'QuarantineCount'}++;      

            } else {
                delete_version($entry->{name}, $entry->{version});
                my $path = join('/', $conf->{dpkg_archive}, $entry->{name}, $entry->{version} );
                if (-d $path) {
                    $logger->warn("Could not delete package: $path");
                    $qStats{'QuarantineError'}++;      
                    $statistics{'QuarantineError'}++;      
                    $emsg = ' - Delete error';

                } else {
                    $qStats{'QuarantineCount'}++;      
                    $statistics{'QuarantineCount'}++;      
                    $emsg = '';
                }
            }

        } else {
            # Package has not been transferred to S3
            # Would have thought this to be very unlikely, but still
            # Since the package is not safely stored away we can't delete it at this point in time
            # Request that it be transferred
            # With luck (or by design) the package will be in S3 by the time the process runs again.
            # 
            requestS3Transfer($entry->{name}, $entry->{version});
            $qStats{'QuarantineTxRequested'}++;
            $statistics{'QuarantineTxRequested'}++;
            $emsg = ' - Not in S3. Transfer requested';
        }

        # Log operation with frills
        $logger->logmsg (sprintf("Quarantined:%s%s,%10.10s,%s %s%s", $testMsg, $entry->{reason}, $entry->{age}, $entry->{name}, $entry->{version}, $emsg ));
        $qStats{'QuarantineToDo'}--;
    }
    $logger->verbose("End doQuarantine");
}

#-------------------------------------------------------------------------------
# Function        : requestS3Transfer  
#
# Description     : Request that another blat daemon transfer a package to S3 
#
# Inputs          : $pname
#                   $pver 
#
# Returns         : Nothing 
#
sub requestS3Transfer
{
    my ($pname, $pver) = @_;

    $conf->{'tagdir'} =~ m~^(.*)/~;
    my $tagRoot = $1;
    my $tag = "$pname::$pver";
    my $s3TransferTagDir = catfile($tagRoot, 's3Transfer' );
    my $s3TransferTag = catfile($s3TransferTagDir, $tag);
    $logger->warn ("requestS3Transfer: Invalid directory: $s3TransferTagDir") unless -d $s3TransferTagDir;

    if ( $conf->{'noTransfers'} ) {
        $logger->logmsg("Request S3 transfer DISABLED: $s3TransferTag")
    } else {
        $logger->logmsg("Request S3 transfer: $s3TransferTag");
        Utils::TouchFile($conf, $s3TransferTag) unless -f $s3TransferTag;
    }
}

#-------------------------------------------------------------------------------
# Function        : pkgInS3  
#
# Description     : Check that a specified package-versions exists in the dpkg_archive
#                   S3 bucket
#
# Inputs          : $pname
#                   $pversion
#
# Returns         : 1 - Package is in S3
#                   0 - Package not found 
#
sub pkgInS3
{
    my ($pname, $pversion) = @_;
    my $objKey = $pname . '__' . $pversion . '.tgz';


    my $s3_cmd = "aws --profile $conf->{'S3Profile'} --output json";
    $s3_cmd .= " s3api head-object --bucket vix-dpkg-archive --key $objKey";

    $logger->verbose2("pkgInS3:s3_cmd:$s3_cmd");

    my $ph;
    my $jsontxt = "";
    if (open ($ph, "$s3_cmd 2>/dev/null |") )
    {
        while ( <$ph> ) {
            chomp;
            $logger->verbose2("pkgInS3:Data: $_");
            $jsontxt .= $_;
        }
        close ($ph);
    }
    if ($jsontxt) {
        $logger->verbose2("pkgInS3: $pname, $pversion Found");
        return 1;
    }

    $logger->verbose2("pkgInS3: $pname, $pversion Not Found");
    return 0;
}

#-------------------------------------------------------------------------------
# Function        : delete_version  
#
# Description     : Delete one version of one package 
#
# Inputs          : $pname
#                   $pver
#
# Returns         : Not used 
#
sub delete_version {
    my($pname, $pver) = @_;
        #
        #   Need to use a helper utilty to delete the package-version
        #       The helper is run as root as it greatly simplified the deletion process
        #       The helper is run via sudo
    my $cmd = "sudo -n ./delete_package.sh $conf->{dpkg_archive} $pname $pver";
    if (open (my $ph, "$cmd 2>&1 |") ) {
      while ( <$ph> ) {
          chomp;
          $logger->verbose2("delete_version: $_");
      }
      close ($ph);
    }
}

#-------------------------------------------------------------------------------
# Function        : explain 
#
# Description     : Display / log the reason a package is being processed
#
# Inputs          : $txt 
#
# Returns         : Nothinf
#
sub explain
{
    my($txt) = @_;
    if ($conf->{explain})
    {
        $logger->verbose2($txt);
        print $explainFh $txt . "\n";
    }
}