#!/usr/bin/perl -w
#
# File    : check_prtdiag
# Purpose : prtdiag output parser
# Author  : Sébastien Phélep (seb@le-seb.org)
# Date    : 2009/01/14
#

# Required packages ========================================================= #
use strict;
use File::Basename;
use Getopt::Std;

# Constants ================================================================= #
my $PROGNAME = basename($0);
my $CONFFILE = "${PROGNAME}.conf";
my $VERSION  = "1.12";

# Globals =================================================================== #
my %conf = ();
my @diag = ();
my $syst = undef;
my $file = undef;
my @failed = ();
my @passed = ();
my %options = ();
my $verbose = undef;
my $cfgfile = undef;

# Functions ================================================================= #

# Default handler for --help
sub HELP_MESSAGE
{
	usage(0);
}

# Default handler for --version
sub VERSION_MESSAGE
{
	usage(0);
}

# Script usage
sub usage
{
	# Get exit status
	my $status = shift;
	my $errmsg = shift;

	# We've been called with an error message.
	# Print it to STDERR with short usage
	if( $errmsg )
	{
		print STDERR "${PROGNAME}: $errmsg\n\n";
		print STDERR "Usage: ${PROGNAME} [-hv] [-c <file>] [-f <file>]\n";
		print STDERR "Try '-h' for help.\n";
	}
	else
	{
		# Print full usage to STDOUT
		print STDOUT << "EOF";

${PROGNAME} - ${VERSION}
Search for SUN hardware errors in prtdiag output.

Usage: ${PROGNAME} [-hv] [-c <file>] [-f <file>]

  -f <file>		: use prtdiag output found in file
  -c <file>		: specify alternate location for config file
			 (default location: '$CONFFILE')
  -h			: this (help) message
  -v			: verbose output
EOF
	}

	# Exit with specified status
	exit($status);
}

# Main starts here =========================================================== #

# Use getopts for processing command line options
usage(3) unless( getopts("f:c:hv",\%options) );

# Need command usage ?
usage(0) if($options{'h'});

# Initialize values
$cfgfile = $options{'c'} ? $options{'c'} : $CONFFILE;
$file = $options{'f'} ? $options{'f'} : undef;
$verbose = $options{'v'} ? 1 : 0;

# Go English !
$ENV{'LANG'} = "C";

# Load config file
unless( open(CONFIG,"<${cfgfile}") )
{
	print STDERR "Initialization error - unable to open file '${cfgfile}' : $!\n";
	exit(3);
}
my $section = undef;
while(<CONFIG>)
{
	chomp();
	
	# Remove comments
	s/#.*//;
	
	# Ignore blank lines
	next if( m/^\s*$/ );
	
	if( m/^\s*\[\s*(.*?)\s*\]\s*$/ )
	{
		$section = $1;
		next;
	}
	elsif( m/^\s*(.*?)\s*=\s*(.*?)\s*$/ )
	{
		$conf{$section}->{$1} = $2 if( defined($section) );
	}
}
close(CONFIG);

# Check minimum config
unless( $file )
{
	unless( defined($conf{'commands'}->{'prtdiag'}) )
	{
		print STDERR "Initialization error - 'prtdiag' command not defined in file '${CONFFILE}' !\n";
		exit(3);
	}

	# Substitute macros
	foreach my $section ( %conf )
	{
		foreach my $param ( keys( %{ $conf{$section} } ) )
		{
			# Command substitution
			if( $conf{$section}->{$param} =~ m/CMD\((.*?)\)/ )
			{
				my $command = $1;
				unless( defined($conf{'commands'}->{$command}) )
				{
					print STDERR "Initialization error - '$command' command not defined in file '${CONFFILE}' !\n";
					exit(3);
				}
			
				my @result = `$conf{'commands'}->{$command} 2>&1`;
				unless( ($?>>8) == 0 )
				{
					print STDERR "Initialization error - Failed Substitution for '$command' : @result !\n";
					exit(3);
				}
			
				chomp($result[0]);
				$conf{$section}->{$param} =~ s/CMD\($command\)/$result[0]/;
			}
		}
	}
}

# Get prtdiag input
unless( $file )
{
	unless( open(DIAG,"$conf{'commands'}->{'prtdiag'}|") )
	{
		print STDOUT "Failed to create pipe for command '".$conf{'commands'}->{'prtdiag'}."' : $!\n";
		exit(3);
	}
}
else
{
	unless( open(DIAG,"<$file") )
	{
		print STDOUT "Failed to open file '$file' for reading : $!\n";
		exit(3);
	}
}
while(<DIAG>)
{
	chomp();
	s/^\s*(.*?)\s*$/$1/;
	push(@diag,$_);
}
close(DIAG);

# Look for system type
unless( defined($syst) )
{
	FSYS:
	foreach my $section ( keys(%conf) )
	{
		foreach my $param ( keys(%{ $conf{$section} }) )
		{
			next unless( $param eq "system.match" );
			if( grep(/$conf{$section}->{'system.match'}/,@diag) )
			{
				$syst = $section;
				last FSYS;
			}
		}
	}
}

# Check for unidentified system type
unless( defined($syst) )
{
	print STDOUT "Unable to identify system type !\n";
	exit(3);
}
print STDERR "Using system type : $syst\n" if( $verbose);

# Further config checks
unless( defined($conf{$syst}->{'system.checks'}) )
{
	print STDOUT "Initialization failed - Missing 'system.checks' entry for section '$syst' in file '$CONFFILE' !\n";
	exit(3);
}
my @checks = split(/\s*,\s*/,$conf{$syst}->{'system.checks'});
if( scalar(@checks) == 0 )
{
	print STDOUT "No check defined in 'system.checks' entry for section '$syst' in file '$CONFFILE' !\n";
	exit(3);
}
foreach my $check ( @checks )
{
	foreach my $param ( "description", "begin_match", "end_match", "data_match", "data_labels", "ok_condition", "output_string" )
	{
		my $param_name = "checks.$check.$param";
		unless( defined($conf{$syst}->{$param_name}) )
		{
			print STDOUT "Initialization error - Missing '$param_name' entry for section '$syst' in file '$CONFFILE' !\n";
			exit(3);
		}
	}
}

# Check'em all
foreach my $check ( @checks )
{
	# Get associated data
	my $description = $conf{$syst}->{"checks.$check.description"};
	my @labels = split(/\s*,\s*/,$conf{$syst}->{"checks.$check.data_labels"});
	my $fetch_mode = $conf{$syst}->{"checks.$check.fetch_mode"};
	my $begin = 0;
	my $dcount = 0;
	my $lcount = 0;
	my %data = ();
	
	print STDERR "\nChecking $description:\n" if( $verbose);

	# Parse prtdiag output
	DIAG: foreach( @diag )
	{
		unless( $begin )
		{
			# Looking for begin pattern
			next DIAG unless( m/$conf{$syst}->{"checks.$check.begin_match"}/ );
			s/$conf{$syst}->{"checks.$check.begin_match"}//;
			$begin = 1;
		}
		else
		{
			# Stop parsing if matched end pattern
			last DIAG if( m/$conf{$syst}->{"checks.$check.end_match"}/ );
		}
		
		# Skip unwanted data
		if( defined($conf{$syst}->{"checks.$check.skip_match"}) )
		{
			next DIAG if( m/$conf{$syst}->{"checks.$check.skip_match"}/ );
		}
		
		# Reinit read values
		my @values = ();
		
		# === Fetching data in linear mode === #
		if( defined($fetch_mode) and ($fetch_mode eq "linear") )
		{
			# Use specified regexp separator, or define a default one
			my $regexp_separator = $conf{$syst}->{"checks.$check.data_match_regsep"} || '\s*,\s';

			# Extract regular expresssions to be used for data collection
			my @dmatch = split(/\s*,\s*/,$conf{$syst}->{"checks.$check.data_match"});
			
			# Take care of counters
			if( $lcount >= scalar(@labels) )
			{
				$lcount = 0;
				$dcount = $dcount + scalar(@labels) + 1;
			}
			
			# Get all matching values
			@values = m/$dmatch[$lcount]/g;
			
			# Update our hash
			for( my $i=0; $i < scalar(@values); $i++ )
			{
				$data{($dcount+$i)}->{$labels[$lcount]} = $values[$i];
			}
			$lcount++;
			
			# Next one
			next DIAG;
		}
		# === Fetching data otherwise (aka tabular mode) === #
		else
		{
			# Next one if this does not match
			next DIAG unless( @values = m/$conf{$syst}->{"checks.$check.data_match"}/g );
			
			# Update our hash
			for( my $i=0; $i < scalar(@values); $i++ )
			{
				# Take care of counters
				if( $lcount >= scalar(@labels) )
				{
					$lcount = 0;
					$dcount++;
				}
				
				$data{$dcount}->{$labels[$lcount]} = $values[$i];
				$lcount++;
			}
		}
	}
	
	# Check collected data
	my $errors = 0;
	my $tests = 0;
	foreach my $dataset ( keys(%data) )
	{
		my $test_result = "";
		my $ok_condition = $conf{$syst}->{"checks.$check.ok_condition"};
		my $output_string = $conf{$syst}->{"checks.$check.output_string"};

		# Substitute labels in condition and output string
		foreach my $label ( keys( %{ $data{$dataset} } ) )
		{
			$ok_condition =~ s/%$label%/$data{$dataset}->{$label}/g;
			$output_string =~ s/%$label%/$data{$dataset}->{$label}/g;
		}
		
		# Test condition
		if( eval($ok_condition) )
		{
			# Test passed
			$test_result = "INF - $output_string";
			push(@passed,$output_string);
		}
		else
		{
			# Test failed
			$test_result = "ERR - $output_string";
			push(@failed,$output_string);
			$errors++;
			
		}
		$tests++;
		print STDERR " $test_result\n" if( $verbose);
	}
	print STDERR "Checked $tests component".( $tests le 1 ? "" : "s").", found ".( $errors == 0 ? "no error" : "$errors errors" ).".\n" if( $verbose );
}

# Analyze global results
my $checked = scalar(@passed) + scalar(@failed);
if( scalar(@failed) > 0 )
{
	print STDERR "\n" if( $verbose );
	print STDOUT "CRITICAL - Checked $checked component".( $checked le 1 ? "" : "s").", found ".scalar(@failed)." errors : ".join(', ',@failed)."|";
	print STDOUT join(', ',@passed);
	print STDOUT "\n";
	exit(2);
}
elsif( $checked == 0 )
{
	print STDERR "\n" if( $verbose );
	print STDOUT "WARNING - Found nothing to check !\n";
	exit(1);
}
else
{
	print STDERR "\n" if( $verbose );
	print STDOUT "OK - Successfully checked $checked component".( $checked le 1 ? "" : "s")."|";
	print STDOUT join(', ',@passed);
	print STDOUT "\n";
	exit(0);
}