Subversion Repositories DevTools

Rev

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

#! /usr/bin/perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : blats3Manifest.pl
# Module type   :
# Compiler(s)   : Perl
# Environment(s):
#
# Description   :   This is a blat related task that will perform S3 SYNC
#                   transfers for configured releases
#
# Usage         :   ARGV[0] - Path to config file for this instance
#
#......................................................................#

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 File::Path qw( rmtree );
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use JSON;

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 $tagDirTime = 0;
my $lastDirScan = 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 $activeReleases;
my $RMerror = 0;                        # Error on last RM DB access

#
#   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
    slowGen => 0,                       # Requests that exceed max time
                                        # 
                                        # The following are reset each day
    dayStart => 0,                      # DateTime when daily data was reset
    txCount => 0,                       # Packages Transferred
    txBytes => 0,                       # Bytes Transferred
    linkErrors => 0,                    # Transfer (S3) errors
    dbErrors => 0,                      # Database errors
                                        # 
                                        # Per Cycle Data - Calculated each processing Cycle
    total => 0,                         # Number targets
);

#
#   Describe configuration parameters
#
my %cdata = (
    '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'   => '30m'  , 'fmt' => 'period'},
    'waitTime'        => {'default'   => '60m'  , 'fmt' => 'period'},

    '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

    'tagdir'          => {'mandatory' => 1      , 'fmt' => 'mkdir'},
    'workdir'         => {'mandatory' => 1      , 'fmt' => 'mkdir'},
    'forcedirscan'    => {'default'   => 100    , 'fmt' => 'period'},
    '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'},

    'RM_USERNAME_RW'  => {'mandatory' => 1      , 'fmt' => 'text'},
    'RM_PASSWORD_RW'  => {'mandatory' => 1      , 'fmt' => 'text'},
    'RM_LOCATION'     => {'default' => undef    , 'fmt' => 'text'},
    

);


#
#   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();

#
#   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} = 'Monitor Requests';
            monitorRequests();

            $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';

        #
        #   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("s3Manifest is inactive") unless ( $conf->{'active'} );
    }

    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        : monitorRequests
#
# Description     : Monitor s3Manifest requests
#                   This is simply done my polling Release Manager - at the moment
#
# Inputs          : None
#
# Returns         : Nothing
#
sub monitorRequests
{
    #
    #   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
    #
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
    {
        $logger->verbose2("monitorRequests: $conf->{'tagdir'}");
        #$logger->verbose2("monitorRequests: mtime:" . ($mtime > $tagDirTime));
        #$logger->verbose2("monitorRequests: last:" . ($now > ($lastDirScan + $conf->{'forcedirscan'})));

        #
        #   Package tags information is not really used
        #       Just delete all the tags
        #       Used to trigger the scan - rather than rely on the slow data
        #       base poll. Still need a change in release sequence number
        #   
        my $dh;
        unless (opendir($dh, $conf->{'tagdir'}))
        {
            $logger->warn ("can't opendir $conf->{'tagdir'}: $!");
            return;
        }

        #
        #   Process each entry
        #       Ignore those that start with a .
        #       Remove all files
        #
        while (my $tag = readdir($dh) )
        {
            next if ( $tag =~ m~^\.~ );
            my $file = "$conf->{'tagdir'}/$tag";
            $logger->verbose3("processTags: $file");

            next unless ( -f $file );
            unlink $file;
        }

        #
        #   Reset the scan time triggers
        #   
        $tagDirTime = $mtime;
        $lastDirScan = $now;

        #
        #   Examine Release Manager looking for snapshot releases that have s3Manifest support that have not
        #   been satisfied.
        #
        $ENV{GBE_RM_USERNAME} = $conf->{RM_USERNAME_RW} ;
        $ENV{GBE_RM_PASSWORD} = $conf->{RM_PASSWORD_RW} ;
        $ENV{GBE_RM_LOCATION} = $conf->{RM_LOCATION} if defined $conf->{RM_LOCATION};
        
        connectRM(\$RM_DB, $conf->{verbose} > 3);

        my $m_sqlstr = "SELECT rtag_id, parent_rtag_id, s3manifest, s3manifest_done " .
                       "FROM release_manager.release_tags rt " .
                       "WHERE rt.OFFICIAL = 'S' " .
                       "      AND rt.S3MANIFEST = 'Y' " .
                       "      AND rt.S3MANIFEST_DONE != 'Y' " .
                       "ORDER BY rtag_id ";
        my $stuckEntry = 0;
        my $curData = getDataFromRm ('monitorRequests', $m_sqlstr, {data => 0, sql => 0, dump => 0} );
        $dbUp = !$RMerror;

        if ($curData) {
            $statistics{total} = scalar @{$curData};

            # Add new enties to the set to process
            foreach my $entry (@{$curData}) {
                my ($rtag_id, $parent_rtag_id) = @{$entry};
                unless ( exists $activeReleases->{$rtag_id}) {
                    $logger->logmsg("New Release Detected. rtag_id: $rtag_id, parent_rtag_id:$parent_rtag_id");
                    $activeReleases->{$rtag_id}{parent_rtag_id} = $parent_rtag_id;
                    $activeReleases->{$rtag_id}{rtag_id} = $rtag_id;
                    $activeReleases->{$rtag_id}{startTime} = $now;
                    $lastTagListUpdate = 0;
                }
            }

            # Process all the entries
            foreach my $rtag_id ( sort keys %{$activeReleases} ) {
                processSnapshot($rtag_id);

                # Warn if stuck entry
                # Repeat the warning on periodic basis
                if (exists $activeReleases->{$rtag_id}) {
                    my $entry = $activeReleases->{$rtag_id};
                     
                    if ($now - $activeReleases->{$rtag_id}{startTime} > $conf->{waitTime}) {
                        $logger->warn("Max waitTime exceeded: rtag_id: $rtag_id, parent_rtag_id:$entry->{parent_rtag_id}");
                        $activeReleases->{$rtag_id}{startTime} = $now;
                        $entry->{isStuck} = 1;
                    }

                    if ($entry->{isStuck}) {
                        $stuckEntry++;
                    }

                }
            }
        }
        $statistics{slowGen} = $stuckEntry; 
        disconnectRM(\$RM_DB);
    }
}

#-------------------------------------------------------------------------------
# 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        : processSnapshot 
#
# Description     : Process a snaphot entry
#                   Ensure all dependent packages are in the master S3 pkg_archive bucket
#                   before creating the actual manifest 
#
# Inputs          : $rtagId
#
# Returns         : Nothing 
#
sub processSnapshot
{
    my ($rtagId) = @_;
    my $data = $activeReleases->{$rtagId};
    return unless defined $data;
    $logger->logmsg("Process: $rtagId $data->{parent_rtag_id}");

#Utils::DebugDumpData("Data", $data);

    unless (exists $data->{depList}) {
        $logger->verbose2("processSnapshot:GetDeps: $rtagId");

        #   Looks like a new entry - get the packages flagged for the manifest
        #   Determine all the package version that should go into the manifest
        #
        my $m_sqlstr = "SELECT rc.pv_id, p.PKG_NAME, pv.PKG_VERSION, pv.v_ext, 0" .
                        " FROM release_manager.RELEASE_CONTENT rc, release_manager.PACKAGE_VERSIONS pv, release_manager.PACKAGES p " .
                        " WHERE rc.RTAG_ID = $rtagId " .
                        "  AND rc.IN_MANIFEST = 'Y' " .
                        "  AND rc.pv_id = pv.pv_id " .
                        "  AND p.pkg_id = pv.pkg_id";

        #
        #   depList is an array:
        #       pv_id, pkg_name, pkg_version, v_ext, found
        $data->{depList} = getDataFromRm ('processSnapshot', $m_sqlstr, {data => 0} );
    }

    #
    #   Iterate over all the required dependencies and check that they exist
    #       I don't know a way of doing it all in one request
    #
    my $allFound = 1;       
    foreach my $entry ( @{$data->{depList}} )
    {
#        Utils::DebugDumpData("Entry", $entry);
        unless ($entry->[4]) {
            my $pe = checkPackageVersion($entry->[1], $entry->[2]);
            if ($pe) {
                $entry->[4] = 1;
                $logger->logmsg("Found: $entry->[1], $entry->[2]");

            } else {
                $allFound = 0;
                $logger->logmsg("Wait for: $entry->[1], $entry->[2]");
            }
        }
    }

    #   Have scannend all the dependencies
    #   If not all have been found, then we need to wait for them to arrive in the pkg_archive
    #   
    unless ($allFound) {
        $logger->verbose2("processSnapshot:Not all found: $rtagId");
        return;
    }
    $logger->verbose2("processSnapshot:All found: $rtagId");

    #
    #   Generate the manifest as a hash
    #   
    my $manifest;
    $manifest->{rtag_id} = $data->{parent_rtag_id}; 
    $manifest->{formatVersion} = 1;
    $manifest->{snapshot} = $rtagId;
    $manifest->{deployed} = [];
    foreach my $entry ( @{$data->{depList}} ) {
        my $depEntry;
        $depEntry->{package} = $entry->[1];
        $depEntry->{version} = $entry->[2];
        $depEntry->{alias} = $entry->[1] . $entry->[3];
        $depEntry->{pv_id} = $entry->[0];
        $depEntry->{stored} = $entry->[1] . '__' . $entry->[2] . '.tgz';
        push @{$manifest->{deployed}}, $depEntry;
    }

    my $jsonText = to_json( $manifest, { ascii => 1, pretty => 1, canonical => 1 });


#Utils::DebugDumpData("Manifest", $manifest);
    $logger->verbose2("processSnapshot:Manifest: $jsonText");
    my $targetName = 'manifest_' . $manifest->{rtag_id} . '_' . $manifest->{snapshot} . '.json';
    my $file = catdir( $conf->{'workdir'} , $targetName);
    $logger->verbose2("processSnapshot:ManifestFile: $file");
    unlink $file;

    if (open ( my $fh, '>', $file) ) {
        print $fh $jsonText;
        close $fh
    } else {
        $logger->warn("Can't write file: $file. $!");
        return;
    }

    #
    #   Transfer to the S3 bucket
    #   
    #   Create a command to transfer the file to AWS use the cli tools
    #
    $startTime = time;
    my $targetPath = catdir ($conf->{'S3Bucket'}, $targetName );

    my $s3_cmd = "aws --profile $conf->{'S3Profile'} --output json";
    $s3_cmd .= " --region $conf->{'S3Region'}" if (defined $conf->{'S3Region'});
    $s3_cmd .= " s3 cp --quiet $file s3://$targetPath";

    $logger->logmsg("transferManifest:$targetPath");
    $logger->verbose2("transferManifest:s3_cmd:$s3_cmd");

    my $cmdRv;
    unless ($conf->{'noTransfers'}) {
        my $ph;
        open ($ph, "$s3_cmd 2>&1 |");
        while ( <$ph> )
        {
            chomp;
            $logger->verbose2("transferManifest:Data: $_");
        }
        close ($ph);
        $cmdRv = $?;
        $logger->verbose("transferManifest:End: $cmdRv");
    }

    if ($cmdRv != 0) {
        $logger->warn("transferManifest:Error:$targetPath");
        return;
    }

    #
    #   Display the size of the package
    #       Diagnostic use
    #
    if ($conf->{txdetail}) {
        my $tzfsize = -s $file;
        my $duration = time - $startTime;
        $logger->logmsg("S3 Copy: Stats: $targetName, $tzfsize Bytes, $duration Secs");
    }

    $statistics{txCount}++;
    $statistics{txBytes} += -s $file;

    #
    #   Mark the Release Manager entry as done
    #       Need Write access to do this
    #
    $logger->verbose("Update database: $rtagId");
    my $rv = executeRmQuery('MarkDone', "UPDATE release_manager.RELEASE_TAGS SET S3MANIFEST_DONE = 'Y' where RTAG_ID = $rtagId") ;
    if ($rv) {
        return;
    }

    #
    #   Remove the entry from hash of items to be processed
    #
    $logger->logmsg("Complete: $targetName");
    delete $activeReleases->{$rtagId};
    unlink $file;
    $lastTagListUpdate = 0;
    return;
}

#-------------------------------------------------------------------------------
# Function        : checkPackageVersion 
#
# Description     : Check that a specified package-versions exists in the dpkg_archive
#                   S3 bucket
#
# Inputs          : $pname
#                   $pversion
#
# Returns         : Ref to metadata
#                   undef on not found 
#

sub checkPackageVersion
{
    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("checkPackageVersion:s3_cmd:$s3_cmd");

    my $ph;
    my $jsontxt = "";
    if (open ($ph, "$s3_cmd 2>/dev/null |") )
    {
        while ( <$ph> ) {
            chomp;
            $logger->verbose2("checkPackageVersion:Data: $_");
            $jsontxt .= $_;
        }
        close ($ph);
    }
    if ($jsontxt) {
        my $json = from_json ($jsontxt);
#        Utils::DebugDumpData("JSON",$json);
        return $json;
    }
    else {
        $logger->verbose2("checkPackageVersion: $pname, $pversion Not Found");
        return undef;
    }
}


#-------------------------------------------------------------------------------
# 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{txCount} = 0;
        $statistics{txBytes} = 0;
        $statistics{linkErrors} = 0;
        $statistics{dbErrors} = 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 txCount txBytes linkErrors dbErrors);

    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{slowGen}) {
        $statistics{state} = 'Slow manifest generation detected';
    } 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});
            }
            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;
    };

    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("@_");
}