Subversion Repositories DevTools

#! /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});