xcat-core/xCAT-rmc/scripts/errmsgque
2009-04-01 18:03:08 +00:00

177 lines
4.9 KiB
Perl
Executable File

#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
use strict;
use locale;
use Getopt::Std;
use IPC::SysV qw(IPC_STAT S_IRWXU IPC_PRIVATE IPC_CREAT S_IRUSR S_IWUSR );
use IPC::Msg;
my $m = ord('xcat');
my $key = IPC::SysV::ftok("/var/adm/ras/errlog", $m);
# my $msg = new IPC::Msg($key, IPC_CREAT|S_IRUSR|S_IWUSR );
# my $message = join " ", @ARGV;
# $msg->snd(1, "$message");
my $message = join " ", @ARGV;
runcmd("/usr/bin/refsensor ErrorLogSensor String=\"$message\" 1>/dev/null 2>/dev/null", 0);
if($::RUNCMD_RC != 0){
my $msg = new IPC::Msg($key, IPC_CREAT|S_IRUSR|S_IWUSR );
my $stat = $msg->stat;
my $qcurrentlen = $$stat[5];
if ($qcurrentlen >= 10000)
{
if (!-d "/var/opt/xcat_err_mon/")
{
my $cmd = "mkdir -p \"/var/opt/xcat_err_mon\"";
runcmd($cmd, -1);
}
open(FILE, ">>/var/opt/xcat_err_mon/errmsgqueerr.log");
my $sdate = `/bin/date`;
chomp $sdate;
print FILE "$sdate:\n";
print FILE "Can not write the message to queue because the queue is almost full, the message content is: $message\n\n\n";
close FILE;
exit 0;
}
$msg->snd(1, "$message");
}
exit 0;
#--------------------------------------------------------------------------------
=head3 runcmd
Run the given cmd and return the output in an array (already chopped). Alternatively,
if this function is used in a scalar context, the output is joined into a single string
with the newlines separating the lines.
Arguments:
command, exitcode and reference to output
Returns:
see below
Error:
Normally, if there is an error running the cmd, it will display the error msg
and exit with the cmds exit code, unless exitcode is given one of the
following values:
0: display error msg, DO NOT exit on error, but set
$::RUNCMD_RC to the exit code.
-1: DO NOT display error msg and DO NOT exit on error, but set
$::RUNCMD_RC to the exit code.
-2: DO the default behavior (display error msg and exit with cmds
exit code.
number > 0: Display error msg and exit with the given code
Example:
my $outref = runcmd($cmd, -2, 1);
Comments:
If refoutput is true, then the output will be returned as a reference to
an array for efficiency.
=cut
#--------------------------------------------------------------------------------
sub runcmd
{
my ($cmd, $exitcode, $refoutput) = @_;
$::RUNCMD_RC = 0;
if (!($cmd =~ /2>&1$/)) { $cmd .= ' 2>&1'; }
my $outref = [];
@$outref = `$cmd`;
if ($?)
{
$::RUNCMD_RC = $? >> 8;
my $displayerror = 1;
my $rc;
if (defined($exitcode) && length($exitcode) && $exitcode != -2)
{
if ($exitcode > 0)
{
$rc = $exitcode;
} # if not zero, exit with specified code
elsif ($exitcode <= 0)
{
$rc = ''; # if zero or negative, do not exit
if ($exitcode < 0) { $displayerror = 0; }
}
}
else
{
$rc = $::RUNCMD_RC;
} # if exitcode not specified, use cmd exit code
if ($displayerror)
{
my $errmsg = '';
if (($^O =~ /^linux/i) && $::RUNCMD_RC == 139)
{
$errmsg = "Segmentation fault $errmsg";
}
else
{
# The error msgs from the -api cmds are pretty messy. Clean them up a little.
filterRmcApiOutput($cmd, $outref);
$errmsg = join('', @$outref);
chomp $errmsg;
}
print "Exit code $::RUNCMD_RC from command: $cmd\nError message from cmd: $errmsg\n"
}
}
if ($refoutput)
{
chomp(@$outref);
return $outref;
}
elsif (wantarray)
{
chomp(@$outref);
return @$outref;
}
else
{
my $line = join('', @$outref);
chomp $line;
return $line;
}
}
#--------------------------------------------------------------------------------
=head3 filterRmcApiOutput
filter RMC Api Output
Arguments:
RMC command
Output reference
Returns:
none
Globals:
none
Error:
none
Example:
filterRmcApiOutput($cmd, $outref);
Comments:
The error msgs from the RPM -api cmds are pretty messy.
This routine cleans them up a little bit.
=cut
#--------------------------------------------------------------------------------
sub filterRmcApiOutput
{
my ($cmd, $outref) = @_;
if (!($cmd =~ m|^/usr/bin/\S+-api |)) {
return;
} # give as much info as possible, if verbose
# Figure out the output delimiter
my ($d) = $cmd =~ / -D\s+(\S+)/;
if (length($d)) {
$d =~ s/^(\'|\")(.*)(\"|\')$/$2/; # remove any surrounding quotes
# escape any chars perl pattern matching would intepret as special chars
$d =~ s/([\|\^\*\+\?\.])/\\$1/g;
}
else
{
$d = '::';
} # this is the default output delimiter for the -api cmds
$$outref[0] =~ s/^ERROR${d}.*${d}.*${d}.*${d}.*${d}//;
}