xcat-core/xCAT-rmc/scripts/perl/mkrmcresources

#!/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;