mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-11-03 21:02:34 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			873 lines
		
	
	
		
			27 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			873 lines
		
	
	
		
			27 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/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'} != 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;
 | 
						|
 |