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

}