#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
#-------------------------------------------------------------------------------
=head1 mkrmcresources
=head2 mkrmcresources is used to predefine RMC conditions, responses, associations,
sensors (and can be extended to support any RSCT resource
class).
To use the command, create perl modules in a directory. Each resource
should have its own perl module (so that it is easy to update a
resource without interfering with other resources),
and should be named <Resource Name>.pm.
After the resource perl modules are installed, they will be created
by the next execution of the this command.
This command should be called by the post install scripts
of packaging files, script run after install or from the command line.
=cut
#-------------------------------------------------------------------------------
use Getopt::Long;
$Getopt::Long::ignorecase = 0; #Checks case in GetOptions
Getopt::Long::Configure("bundling"); #allows short command line options to be grouped (e.g. -av)
#--------------------------------------------------------------------------------
=head3 quote
Quote a string, taking into account embedded quotes. This function is most
useful when passing string through the shell to another cmd. It handles one
level of embedded double quotes, single quotes, and dollar signs.
Arguments:
string to quote
Returns:
quoted string
Globals:
none
Error:
none
Example:
Comments:
none
=cut
#--------------------------------------------------------------------------------
sub quote
{
my ($str) = @_;
# if the value has imbedded double quotes, use single quotes. If it also has
# single quotes, escape the double quotes.
if (!($str =~ /\"/)) # no embedded double quotes
{
$str =~ s/\$/\\\$/sg; # escape the dollar signs
$str =~ s/\`/\\\`/sg;
$str = qq("$str");
}
elsif (!($str =~ /\'/))
{
$str = qq('$str');
} # no embedded single quotes
else # has both embedded double and single quotes
{
# Escape the double quotes. (Escaping single quotes does not seem to work
# in the shells.)
$str =~ s/\"/\\\"/sg; #" this comment helps formating
$str =~ s/\$/\\\$/sg; # escape the dollar signs
$str =~ s/\`/\\\`/sg;
$str = qq("$str");
}
}
#--------------------------------------------------------------------------------
=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 ($::VERBOSE || !($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}//;
}
sub isHMC
{
my $hmcfile = "/opt/hsc/data/hmcType.properties";
if (-e $hmcfile) { return 1; }
else { return 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 (!$::NO_STDERR_REDIRECT) {
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 runrmccmd
Runs an RMC commmand
Arguments:
$rmccmd, $resclass, $options, $select, $exitcode, $nodelist_ref
Returns:
the output from runcmd($cmd, -2, 1)
as a ref to the output array.
Error:
none
Example:
my $outref =runrmccmd('lsrsrc-api', "-i -D ':|:'", $where);
Comments:
When $nodelist_ref is not null, break it up into smaller slices
and run RMC commands seperately for each slice.
Otherwise just run RMC commands with the arguments passed in.
=cut
#--------------------------------------------------------------------------------
sub runrmccmd
{
my ($rmccmd, $options, $select, $exitcode, $nodelist_ref) = @_;
my @nodelist;
my $return_ref = [];
if (!defined($exitcode))
{
$exitcode = -2;
}
if(! grep /usr\/bin/, $rmccmd)
{
# add absolute path
$rmccmd = "/usr/bin/$rmccmd";
}
if ($nodelist_ref)
{
# check whether to break up nodelist for better scalability.
@nodelist = @$nodelist_ref;
my $divide = 500; # max number of nodes for each division
my @sublist;
my @newarray;
my ($start_index, $end_index, $nodestring);
my $count = 0;
my $times = int(scalar(@nodelist) / $divide);
while ($count <= $times)
{
$start_index = $count * $divide;
$end_index =
((scalar(@nodelist) - 1) < (($count + 1) * $divide - 1))
? (scalar(@nodelist) - 1)
: (($count + 1) * $divide - 1);
@sublist = @nodelist[$start_index .. $end_index];
@newarray = ();
foreach my $node (@sublist)
{
my @vals = split ',|\s', $node;
push @newarray, @vals;
}
$nodestring = join("','", @newarray);
# replace the pattern in select string with the broken up node string
my $select_new = $select;
$select_new =~ s/XXX/$nodestring/;
my $cmd = "$rmccmd $options $select_new";
my $outref = runcmd($cmd, $exitcode, 1);
push @$return_ref, @$outref;
$count++;
}
}
else
{
my $cmd = "$rmccmd $options $select";
$return_ref = runcmd($cmd, $exitcode, 1);
}
# returns a reference to the output array
return $return_ref;
}
#--------------------------------------------------------------------------------
=head3 queryResources
Queries all resources of a given class or classes. Places
results into a global hash for each resource class.
Arguments: a list of RSCT resource classes
Globals: %::EXISTS::{$resource}
=cut
#--------------------------------------------------------------------------------
sub queryResources
{
my @resources = @_;
my $where = "";
foreach my $res (@resources)
{
if ($res eq "IBM.Association")
{
#special case: run lscondresp because Associations do not have names
#cant run lsrsrc because Assoctation also does not store names of resources (just handles)
my @condresp = runcmd("LANG=C /usr/bin/lscondresp");
my $class = $res;
$class =~ s/^IBM\.//;
splice @condresp, 0,
2; #delete first two lines -- they are just comments
foreach my $line (@condresp)
{
my ($condition, $response, $node, $state) = split ' ', $line;
$condition = &removeQuotes($condition);
$response = &removeQuotes($response);
my $key = "${condition}:_:${response}";
my $ActiveFlag = 0; #assume offline
if ($state =~ m/Active/)
{
$ActiveFlag = 1;
}
#currently does not checked for locked
# This \%{typeglob} syntax auto-vivifies
# the hash table for us, and gives us a reference.
my $ref = \%{$::EXISTS::{$class}};
$ref->{$key} = {ActiveFlag => $ActiveFlag,};
}
}
else
{
$where .= " -s ${res}::::'*p0x0020'";
}
}
my $output = runrmccmd("lsrsrc-api", "-i -m -n -D ':|:'", $where);
foreach my $line (@$output)
{
my @array = split(/:\|:/, $line);
my $class = shift @array; #the -m flag puts the class name in front
$class =~ s/^IBM\.//;
my %attrs = @array;
# This \%{typeglob} syntax auto-vivifies
# the hash table for us, and gives us a reference.
my $ref = \%{$::EXISTS::{$class}};
my $key = $attrs{'Name'};
$ref->{$key} = {%attrs}; #sets the EXISTS array with the info
}
}
#--------------------------------------------------------------------------------
=head3 traverseDirectories
Calls readFiles on each sub-directory of the given path.
Creates a global array with all target resource classes.
Arguments: A directory
Globals: @::DIRECTORIES (will hold all resource classes)
=cut
#--------------------------------------------------------------------------------
sub traverseDirectories
{
my ($dir) = @_;
my ($dir_fh, $file);
opendir($dir_fh, $dir)
or die "Can not open directory $dir\n";
while ($file = readdir($dir_fh))
{
if ($file ne '.' and $file ne '..')
{
my $subdir = "$dir/$file";
if (-d $subdir)
{ #only look at directories
&readFiles($subdir);
push @::DIRECTORIES, $file; #file=just the filename
}
}
}
closedir($dir_fh)
or die "Can not close directory $dir\n";
}
#--------------------------------------------------------------------------------
=head3 readFiles
Calls require on all .pm files in a given directory
Arguments: A directory
=cut
#--------------------------------------------------------------------------------
sub readFiles
{
my ($dir) = @_;
my ($dir_fh, $file);
opendir($dir_fh, $dir)
or die "Can not open directory $dir\n";
while ($file = readdir($dir_fh))
{
if ($file ne '.' and $file ne '..')
{
$file = "$dir/$file";
if ($file =~ m/\.pm$/)
{
#its a perl module
require $file;
}
}
}
closedir($dir_fh)
or die "Can not close directory $dir\n";
}
#--------------------------------------------------------------------------------
=head3 compareResources
Compares existing resources to those requiring definition.
Globals: uses %::EXISTS and %::RES and makes %::CHANGE and %::CREATE
=cut
#--------------------------------------------------------------------------------
sub compareResources
{
foreach my $class (@::DIRECTORIES)
{ #this has all subdirectory names
$class =~ s/^IBM\.//; #the IBM prefix is not used in the hash name
local *exi = $::EXISTS::{$class}; #defined on system
local *res = $::RES::{$class}; #defined in file
foreach my $resource (keys %res)
{
if (defined $exi{$resource})
{ #exists on the system
if (defined $res{$resource}{'Locked'}
&& $res{$resource}{'Locked'} == 1)
{
#only change the resource if it is supposed to be locked
foreach my $attr (keys %{$res{$resource}})
{
if ($exi{$resource}{$attr} ne $res{$resource}{$attr})
{
if (!($class eq "Association" && $attr eq "Locked"))
{ # association locked attrs are not stored
# something has changed
if ($::VERBOSE)
{
print "Differs: Class=$class\tExists=$exi{$resource}{$attr}\tDefined=$res{$resource}{$attr}\n";
}
$::CHANGE::{$class}{$resource} = $res{$resource};
last;
}
}
}
}
}
else
{ #resource is not defined on the system
$::CREATE::{$class}{$resource} = $res{$resource};
}
}
}
}
#--------------------------------------------------------------------------------
=head3 removeQuotes
removes starting and ending quotes that are in the output of lsrsrc
Arguments: string
Returns: string with no leading or trailing quotes
=cut
#--------------------------------------------------------------------------------
sub removeQuotes
{
my ($string) = @_;
$string =~ s/^\"|^\'//;
$string =~ s/\"$|\'$//;
return $string;
}
#--------------------------------------------------------------------------------
=head3 createResources
Calls mkrsrc-api on all resources in the %::CREATE hash
Globals: %::CREATE
=cut
#--------------------------------------------------------------------------------
sub createResources
{
my $string;
my $counter = 0;
my @assoc_cmds;
my $sensorflg = 0;
foreach my $class (@::DIRECTORIES)
{ #all the class names
local *cre = $::CREATE::{$class};
if ($class eq "Sensor")
{
$sensorflg = 1;
}
else
{
$sensorflg = 0;
}
foreach my $resource (keys %cre)
{
if ($class eq "Association")
{ #special case
my ($cond, $resp) = split ":_:", $resource;
if ($cre{$resource}{'ActiveFlag'} == 1)
{
push @assoc_cmds, "/usr/bin/startcondresp $cond $resp";
if ($cre{$resource}{'Locked'} == 1)
{
push @assoc_cmds, "/usr/bin/startcondresp -L $cond $resp";
}
}
else
{ #not active
push @assoc_cmds, "/usr/bin/mkcondresp $cond $resp";
#no need to lock stopped associations
}
}
else
{
$string .= " IBM.${class}::";
foreach my $attr (keys %{$cre{$resource}})
{
my $value = $cre{$resource}{$attr};
$string .= "${attr}::" . quote($value) . "::";
}
if (($sensorflg == 1) && ($::INSTALL))
{
# make the Sensor with no userid check
$string .= "::Options::1";
}
#
# Only build up to 10 resources at a pass
# to avoid command line limit
#
$counter = $counter + 1;
if ($counter > 10)
{
if ($string =~ m/\w+/)
{
#my $cmd = "/usr/bin/mkrsrc-api $string";
#print "running $cmd\n";
#system($cmd);
runrmccmd("mkrsrc-api", "", $string);
$string = "";
$counter = 0;
}
}
}
}
}
if ($string =~ m/\w+/) # for any remaining resources
{
#my $cmd = "/usr/bin/mkrsrc-api $string";
#print "running $cmd\n";
#system($cmd);
runrmccmd("mkrsrc-api", "", $string);
}
foreach my $cmd (@assoc_cmds)
{
#need to make associations after conds and resps have been made
runcmd("$cmd");
}
}
#--------------------------------------------------------------------------------
=head3 changeResources
Calls chrsrc-api on all resources in the %::CHANGE hash
Globals: %::CHANGE
=cut
#--------------------------------------------------------------------------------
sub changeResources
{
my $string;
my $ustring; #unlock
my @unlock; #unlock each class
my $where; #unlock each class
foreach my $class (@::DIRECTORIES)
{ #all the class names
local *cha = $::CHANGE::{$class};
foreach my $resource (keys %cha)
{
if ($class eq "Association")
{ #special case
#code here is identical to createResource
my ($cond, $resp) = split ":_:", $resource;
if ($cre{$resource}{'ActiveFlag'} == 1)
{
runcmd("/usr/bin/startcondresp $cond $resp");
if ($cre{$resource}{'Locked'} == 1)
{
runcmd( "/usr/bin/startcondresp -L $cond $resp");
}
}
else
{ #not active
runcmd("/usr/bin/mkcondresp $cond $resp");
#no need to lock stopped associations
}
}
else # not class association
{
$where = qq/"Name IN ('XXX')"/;
$string .= " -s IBM.${class}::${where}::";
push @unlock, $cha{$resource}{'Name'};
delete $cha{$resource}{'Name'};
foreach my $attr (keys %{$cha{$resource}})
{
my $value = $cha{$resource}{$attr};
$string .= "${attr}::" . quote($value) . "::";
}
}
if (@unlock)
{
$where = qq/"Name IN ('XXX')"/;
$ustring .= " -s IBM.${class}::${where}::Locked::'0'";
}
} # foreach resource
} # foreach key
#
# although @unlock contains the resource and not the node name
# this is a hack to use runrmccmd and the node_ref must
# be provided even though we are not really dealing with nodes
# here
if ($ustring =~ m/\w+/) {
runrmccmd("chrsrc-api", "", $ustring, undef, \@unlock);
}
if ($string =~ m/\w+/) {
runrmccmd("chrsrc-api", "", $string, undef, \@unlock);
}
}
#--------------------------------------------------------------------------------
=head3 writeAllFiles
creates all files for the given resources classes
Arguments: a array ref of class names, basedir
=cut
#--------------------------------------------------------------------------------
sub writeAllFiles
{
my @classes = @{shift()};
my $basedir = shift;
print "classes=@classes, basedir=$basedir";
foreach my $class (@classes)
{
my $output = runrmccmd("lsrsrc-api", "-i", "-s ${class}::::Name");
foreach my $line (@$output)
{
&writeFile("${class}::$line", $basedir);
}
}
}
#--------------------------------------------------------------------------------
=head3 writeFile
creates a file with the resource info in
$basedir/<class>
Arguments: class::resource_name, basedir
=cut
#--------------------------------------------------------------------------------
sub writeFile
{
my $input = shift;
my $basedir= shift;
print "input=$input, basedir=$basedir\n";
my ($class, $resourcefilename) = split "::", $input;
if (!$resourcefilename) {
print 'mkrmcresource --mkfile requires <class::resource> as input.\n';
exit 1;
}
my $resource;
push(@$resource, $resourcefilename);
if (!-e "$basedir/$class") {
`mkdir -p "$basedir/$class"`;
}
my $file = "$basedir/$class/$resourcefilename.pm";
my $where = qq/"Name IN ('XXX')"/;
my $string = " -s ${class}::${where}::*p0x0002";
my $output = runrmccmd("lsrsrc-api", "-i -n -D ':|:'",
$string, undef, $resource);
$string = " -s ${class}::${where}::*p0x0008";
my $optional = runrmccmd("lsrsrc-api", "-i -n -D ':|:'",
$string, undef, $resource);
#my @output = runcmd("/usr/bin/lsrsrc -s $where $class");
#uses lsrsrc instead of lsrsrc-api because format is almost right (just needs a few mods)
my $fh;
open($fh, ">$file")
or die "Can not open this file for writing $file.\n";
print $fh "#!/usr/bin/perl\n\n";
$class =~ s/IBM\.//;
print $fh '$RES::' . $class . "{" . "'"
. $resourcefilename . "'"
. "} = {\n";
foreach my $line (@$output)
{
my %attrs = split /:\|:/,
$line; #can't go straight into a hash because -p creates extra fields
foreach my $attr (keys %attrs)
{
if ( $attr !~ m/ActivePeerDomain/
&& $attr !~ m/NodeNameList/
&& $attr !~ m/NodeIDs/)
{
my $value = $attrs{$attr};
if ($value =~ m/\w/ || $value =~ m/\d/)
{
# print "value = |$value|\n";
#$value = &removeQuotes($value); #quotes are not needed becaues of q()
#print "value = |$value|\n";
my $line = "\t$attr => q($value),";
print $fh "$line\n";
}
}
}
}
foreach my $line (@$optional)
{
my %attrs = split /:\|:/,
$line; #can't go straight into a hash because -p creates extra fields
foreach my $attr (keys %attrs)
{
if ( $attr !~ m/ActivePeerDomain/
&& $attr !~ m/NodeNameList/
&& $attr !~ m/NodeIDs/)
{
my $value = $attrs{$attr};
if ($value =~ m/\w/ || $value =~ m/\d/)
{
# print "value = |$value|\n";
#$value = &removeQuotes($value); #quotes are not needed becaues of q()
#print "value = |$value|\n";
my $line = "\t$attr => q($value),";
print $fh "$line\n";
}
}
}
}
print $fh "};";
print $fh "\n";
print $fh "1;";
print $fh "\n";
close($fh)
or die "cabbit close file $file\n";
}
#--------------------------------------------------------------------------------
=head3 usage
Prints the command usage statement
=cut
#--------------------------------------------------------------------------------
sub usage
{
print "Usage:
mkrmcresources [--install|--mkfile classname::rsrcname|--mkall] \
[-V|--verbose] directory\n\
mkrmcresources -h|--help\n\
directory a full path to a base directory for resurce files \
to be created or to be read from. \
-V|--verbose Verbose mode.\
-h|--help shows usage information.\
--install\
The userid in the Sensor resource will not be verified.\n";
}
#######################################################################
# main Main MAIN
#######################################################################
# get arguments
if (
!GetOptions(
'h|help' => \$::HELP,
'V|verbose' => \$::VERBOSE,
'install' => \$::INSTALL,
'mkfile=s' => \$::MKFILE,
'mkall' => \$::MKALL,
)
)
{
&usage;
exit 1;
}
if ($::HELP) { &usage; exit; }
if (isHMC() && ($ENV{'DC_ENVIRONMENT'} ne 1))
{
print "mkresources is not supported on HMC.\n";
}
# any function requested
if (@ARGV < 1) {
&usage;
exit 1;
}
my $basedir = $ARGV[0];
if ($::MKFILE) {
&writeFile($::MKFILE, $basedir);
exit;
}
if ($::MKALL) {
@rsrc_classes=('IBM.Condition', 'IBM.EventResponse', 'IBM.Sensor');
&writeAllFiles(\@rsrc_classes, $basedir);
exit;
}
&traverseDirectories($basedir);
#TODO: wait for RSCT to come online
&queryResources(@::DIRECTORIES);
#compares whats defined in the files to the existing resources
&compareResources();
&createResources();
&changeResources();
END
{
}
exit 0;