Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : blatReleaseNotes.pl
# Module type   :
# Compiler(s)   : Perl
# Environment(s):
#
# Description   :   This is a blat related task that will generate Release
#                   Notes as required by the build system
#                   
#                   Replaces a cron job that did the same task as cron
#                   will only run once a minute.
#
# 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;

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 $mtimeConfig = 0;
my $conf;
my $yday = -1;
my $tagRoot;
my $linkState = 0;

#
#   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
    txCount => 0,                       # Packages Transferred - Release Notes Generated
    linkErrors => 0,                    # Transfer errors - Errors encountered
                                        # 
                                        # Per Cycle Data - Calculated each processing Cycle
                                        # None for Release Notes
);

#
#   Describe configuration parameters
#
my %cdata = (
    'piddir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
    'sleep'           => {'default'   => 5      , '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'},
    'verbose'         => {'default'   => 0      , 'fmt' => 'int'},
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},
    'tagdir'          => {'mandatory' => 1      , 'fmt' => 'mkdir'},
    'forcedirscan'    => {'default'   => 100    , 'fmt' => 'period'},
    'tagage'          => {'default'   => '10d'  , 'fmt' => 'period'},
    'wedgeTime'       => {'default'   => '30m'  , 'fmt' => 'period'},

    'JIRA_URL'        => {'mandatory' => 1      , 'fmt' => 'text'},
    'JIRA_USERNAME'   => {'mandatory' => 1      , 'fmt' => 'text'},
    'JIRA_PASSWORD'   => {'mandatory' => 1      , 'fmt' => 'text'},
    'RM_USERNAME_RW'  => {'mandatory' => 1      , 'fmt' => 'text'},
    'RM_PASSWORD_RW'  => {'mandatory' => 1      , '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}++;
    Utils::resetWedge();
    $now = time();

    $statistics{phase} = 'ReadConfig';
    readConfig();
    if ( $conf->{'active'} )
    {
        $statistics{phase} = 'Monitor Tags';
        processRequests();
    }

    $statistics{phase} = 'Sleep';
    sleep( $conf->{'sleep'} );
    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';

        #
        #   Calculate the base of the tags directory
        #   ASSUME all tagdirs are in the same tree as my tags dir
        #
        $conf->{'tagdir'} =~ m~^(.*)/~;
        $tagRoot = $1;
    }

    #
    #   When config is read force some actions

#Utils::DebugDumpData ("Config", $conf);

    $logger->warn("ReleaseNote is inactive") unless ( $conf->{'active'} );
    return $rv;
}


#-------------------------------------------------------------------------------
# Function        : processRequests
#
# Description     : Process tags and generate Release Notes as required
#                       Determine if new tags are present - really just
#                       a trigger mechanism
#
# Inputs          : None
#
# Returns         : Nothing
#
sub processRequests
{
    #
    #   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("processTags: ,$conf->{'tagdir'}");
        $tagDirTime = $mtime;
        $lastDirScan = $now;


        #
        #   Delete any tags that we find
        #   
        my @tags = glob (catdir($conf->{'tagdir'}, '*::*'));
        unlink @tags;

        #
        #   Release notes generation is done my an exernal program
        #   Need to set up some EnvVars for config
        #
        foreach  (qw (JIRA_URL JIRA_USERNAME JIRA_PASSWORD RM_USERNAME_RW RM_PASSWORD_RW) ) {
            $ENV{$_} = $conf->{$_};
        }

        my $jats = '/usr/local/bin/jats';
        my $releaseNotes = "$conf->{dpkg_archive}/generate_release_notes/latest/scripts/process_release_notes.pl";
        my $opts = "-status";
        $opts .= ' -v' if ($conf->{verbose} > 1);
        $opts .= ' -v' if ($conf->{verbose} > 2);

        $logger->err("Jats not found: $jats") unless (-f $jats);
        $logger->err("ReleaseNote program not found: $releaseNotes") unless (-f $releaseNotes);

        #
        #   Execute the command and grab the output for logging purposes
        #   
        my $rnCmd = "$jats -abt=1 eprog $releaseNotes $opts";
        my $ph;
        open ($ph, "$rnCmd |");
        while ( <$ph> )
        {
            chomp;
            # Detect a package being processed
            if (m~\(M\)\s+---~) {
                $logger->logmsg($_);
                $statistics{txCount}++;
            }
            if (m~\]\s\(E\)\s~) {
                $logger->logmsg($_);
            }
            $logger->verbose2("PRN:Data: $_");
        }
        close ($ph);
        my $cmdRv = $?;
        $logger->verbose("PRN:End: $cmdRv");
        $logger->warn("ReleaseNote return Code: $cmdRv") if $cmdRv;
        $statistics{linkErrors}++ if $cmdRv;
        $linkState = ($cmdRv eq 0);

    }
}

#-------------------------------------------------------------------------------
# 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{linkErrors} = 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 linkErrors);

    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(!$linkState){
        $statistics{state} = 'ReleaseNote generation Error';
    } 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          : Nothing
#
# 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 - nothing yet
        $logger->logmsg('Received SIGUSR1.');
    };

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