87fbe622ce
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@3615 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
476 lines
15 KiB
Perl
476 lines
15 KiB
Perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
package xCAT::NodeRange;
|
|
require xCAT::Table;
|
|
require Exporter;
|
|
use strict;
|
|
|
|
#Perl implementation of noderange
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT = qw(noderange nodesmissed);
|
|
our @EXPORT_OK = qw(extnoderange abbreviate_noderange);
|
|
|
|
my $missingnodes=[];
|
|
my $nodelist; #=xCAT::Table->new('nodelist',-create =>1);
|
|
#my $nodeprefix = "node";
|
|
my @allnodeset;
|
|
my $retaincache=0;
|
|
my $recurselevel=0;
|
|
|
|
|
|
sub subnodes (\@@) {
|
|
#Subtract set of nodes from the first list
|
|
my $nodes = shift;
|
|
my $node;
|
|
foreach $node (@_) {
|
|
@$nodes = (grep(!/^$node$/,@$nodes));
|
|
}
|
|
}
|
|
sub nodesmissed {
|
|
return @$missingnodes;
|
|
}
|
|
|
|
sub expandatom {
|
|
my $atom = shift;
|
|
my $verify = (scalar(@_) == 1 ? shift : 1);
|
|
my @nodes= ();
|
|
#TODO: these env vars need to get passed by the client to xcatd
|
|
my $nprefix=(defined ($ENV{'XCAT_NODE_PREFIX'}) ? $ENV{'XCAT_NODE_PREFIX'} : 'node');
|
|
my $nsuffix=(defined ($ENV{'XCAT_NODE_SUFFIX'}) ? $ENV{'XCAT_NODE_SUFFIX'} : '');
|
|
if ($nodelist->getAttribs({node=>$atom},'node')) { #The atom is a plain old nodename
|
|
return ($atom);
|
|
}
|
|
if ($atom =~ /^\(.*\)$/) { # handle parentheses by recursively calling noderange()
|
|
$atom =~ s/^\((.*)\)$/$1/;
|
|
$recurselevel++;
|
|
return noderange($atom);
|
|
}
|
|
if ($atom =~ /@/) {
|
|
$recurselevel++;
|
|
return noderange($atom);
|
|
}
|
|
|
|
# Try to match groups?
|
|
my $grptab = xCAT::Table->new('nodegroup');
|
|
my @grplist;
|
|
if ($grptab) {
|
|
@grplist = @{$grptab->getAllEntries()};
|
|
}
|
|
my $isdynamicgrp = 0;
|
|
foreach my $grpdef_ref (@grplist) {
|
|
my %grpdef = %$grpdef_ref;
|
|
# Try to match a dynamic node group
|
|
# do not try to match the static node group from nodegroup table,
|
|
# the static node groups are stored in nodelist table.
|
|
if (($grpdef{'groupname'} eq $atom) && ($grpdef{'grouptype'} eq 'dynamic'))
|
|
{
|
|
$isdynamicgrp = 1;
|
|
my $grpname = $atom;
|
|
my %grphash;
|
|
$grphash{$grpname}{'objtype'} = 'group';
|
|
$grphash{$grpname}{'grouptype'} = 'dynamic';
|
|
$grphash{$grpname}{'wherevals'} = $grpdef{'wherevals'};
|
|
my $memberlist = xCAT::DBobjUtils->getGroupMembers($grpname, \%grphash);
|
|
foreach my $grpmember (split ",", $memberlist)
|
|
{
|
|
push @nodes, $grpmember;
|
|
}
|
|
last; #there should not be more than one group with the same name
|
|
}
|
|
}
|
|
# The atom is not a dynamic node group, is it a static node group???
|
|
if(!$isdynamicgrp)
|
|
{
|
|
foreach($nodelist->getAllAttribs('node','groups')) {
|
|
my @groups=split(/,/,$_->{groups}); #The where clause doesn't guarantee the atom is a full group name, only that it could be
|
|
if (grep { $_ eq "$atom" } @groups ) {
|
|
push @nodes,$_->{node};
|
|
}
|
|
}
|
|
}
|
|
|
|
# check to see if atom is a defined group name that didn't have any current members
|
|
if ( scalar @nodes == 0 ) {
|
|
for my $row ( $nodegroup->getAllAttribs('groupname') ) {
|
|
if ( $row->{groupname} eq $atom ) {
|
|
return ();
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($atom =~ m/^[0-9]+\z/) { # if only numbers, then add the prefix
|
|
my $nodename=$nprefix.$atom.$nsuffix;
|
|
return expandatom($nodename,$verify);
|
|
}
|
|
my $nodelen=@nodes;
|
|
if ($nodelen > 0) {
|
|
return @nodes;
|
|
}
|
|
|
|
if ($atom =~ m/^\//) { # A regular expression
|
|
unless ($verify) { # If not in verify mode, regex makes zero possible sense
|
|
return ($atom);
|
|
}
|
|
#TODO: check against all groups
|
|
$atom = substr($atom,1);
|
|
unless (scalar(@allnodeset)) {
|
|
@allnodeset = $nodelist->getAllAttribs('node');
|
|
}
|
|
foreach (@allnodeset) { #$nodelist->getAllAttribs('node')) {
|
|
if ($_->{node} =~ m/^${atom}$/) {
|
|
push(@nodes,$_->{node});
|
|
}
|
|
}
|
|
return(@nodes);
|
|
}
|
|
|
|
if ($atom =~ m/(.*)\[(.*)\](.*)/) { # square bracket range
|
|
#for the time being, we are only going to consider one [] per atom
|
|
#xcat 1.2 does no better
|
|
my @subelems = split(/([\,\-\:])/,$2);
|
|
my $subrange="";
|
|
while (my $subelem = shift @subelems) {
|
|
my $subop=shift @subelems;
|
|
$subrange=$subrange."$1$subelem$3$subop";
|
|
}
|
|
foreach (split /,/,$subrange) {
|
|
my @newnodes=expandatom($_,$verify);
|
|
@nodes=(@nodes,@newnodes);
|
|
}
|
|
return @nodes;
|
|
}
|
|
|
|
if ($atom =~ m/\+/) { # process the + operator
|
|
$atom =~ m/^(.*)([0-9]+)([^0-9\+]*)\+([0-9]+)/;
|
|
my $pref=$1;
|
|
my $startnum=$2;
|
|
my $suf=$3;
|
|
my $end=$4+$startnum;
|
|
my $endnum = sprintf("%d",$end);
|
|
if (length ($startnum) > length ($endnum)) {
|
|
$endnum = sprintf("%0".length($startnum)."d",$end);
|
|
}
|
|
if (($pref eq "") && ($suf eq "")) {
|
|
$pref=$nprefix;
|
|
$suf=$nsuffix;
|
|
}
|
|
foreach ("$startnum".."$endnum") {
|
|
my @addnodes=expandatom($pref.$_.$suf,$verify);
|
|
@nodes=(@nodes,@addnodes);
|
|
}
|
|
return (@nodes);
|
|
}
|
|
|
|
if ($atom =~ m/[-:]/) { # process the minus range operator
|
|
my $left;
|
|
my $right;
|
|
if ($atom =~ m/:/) {
|
|
($left,$right)=split /:/,$atom;
|
|
} else {
|
|
my $count= ($atom =~ tr/-//);
|
|
if (($count % 2)==0) { #can't understand even numbers of - in range context
|
|
if ($verify) {
|
|
push @$missingnodes,$atom;
|
|
return ();
|
|
} else { #but we might not really be in range context, if noverify
|
|
return ($atom);
|
|
}
|
|
}
|
|
my $expr="([^-]+?".("-[^-]*"x($count/2)).")-(.*)";
|
|
$atom =~ m/$expr/;
|
|
$left=$1;
|
|
$right=$2;
|
|
}
|
|
if ($left eq $right) { #if they said node1-node1 for some strange reason
|
|
return expandatom($left,$verify);
|
|
}
|
|
my @leftarr=split(/(\d+)/,$left);
|
|
my @rightarr=split(/(\d+)/,$right);
|
|
if (scalar(@leftarr) != scalar(@rightarr)) { #Mismatch formatting..
|
|
if ($verify) {
|
|
push @$missingnodes,$atom;
|
|
return (); #mismatched range, bail.
|
|
} else { #Not in verify mode, just have to guess it's meant to be a nodename
|
|
return ($atom);
|
|
}
|
|
}
|
|
my $prefix = "";
|
|
my $suffix = "";
|
|
foreach (0..$#leftarr) {
|
|
my $idx = $_;
|
|
if ($leftarr[$idx] =~ /^\d+$/ and $rightarr[$idx] =~ /^\d+$/) { #pure numeric component
|
|
if ($leftarr[$idx] ne $rightarr[$idx]) { #We have found the iterator (only supporting one for now)
|
|
my $prefix = join('',@leftarr[0..($idx-1)]); #Make a prefix of the pre-validated parts
|
|
my $luffix; #However, the remainder must still be validated to be the same
|
|
my $ruffix;
|
|
if ($idx eq $#leftarr) {
|
|
$luffix="";
|
|
$ruffix="";
|
|
} else {
|
|
$ruffix = join('',@rightarr[($idx+1)..$#rightarr]);
|
|
$luffix = join('',@leftarr[($idx+1)..$#leftarr]);
|
|
}
|
|
if ($luffix ne $ruffix) { #the suffixes mismatched..
|
|
if ($verify) {
|
|
push @$missingnodes,$atom;
|
|
return ();
|
|
} else {
|
|
return ($atom);
|
|
}
|
|
}
|
|
foreach ($leftarr[$idx]..$rightarr[$idx]) {
|
|
my @addnodes=expandatom($prefix.$_.$luffix,$verify);
|
|
@nodes=(@nodes,@addnodes);
|
|
}
|
|
return (@nodes); #the return has been built, return, exiting loop and all
|
|
}
|
|
} elsif ($leftarr[$idx] ne $rightarr[$idx]) {
|
|
if ($verify) {
|
|
push @$missingnodes,$atom;
|
|
return ();
|
|
} else {
|
|
return ($atom);
|
|
}
|
|
}
|
|
$prefix .= $leftarr[$idx]; #If here, it means that the pieces were the same, but more to come
|
|
}
|
|
#I cannot conceive how the code could possibly be here, but whatever it is, it must be questionable
|
|
if ($verify) {
|
|
push @$missingnodes,$atom;
|
|
return (); #mismatched range, bail.
|
|
} else { #Not in verify mode, just have to guess it's meant to be a nodename
|
|
return ($atom);
|
|
}
|
|
}
|
|
|
|
push @$missingnodes,$atom;
|
|
if ($verify) {
|
|
return ();
|
|
} else {
|
|
return ($atom);
|
|
}
|
|
}
|
|
|
|
sub retain_cache { #A semi private operation to be used *ONLY* in the interesting Table<->NodeRange module interactions.
|
|
$retaincache=shift;
|
|
}
|
|
sub extnoderange { #An extended noderange function. Needed as the more straightforward function return format too simple for this.
|
|
my $range = shift;
|
|
my $namedopts = shift;
|
|
my $verify=1;
|
|
if ($namedopts->{skipnodeverify}) {
|
|
$verify=0;
|
|
}
|
|
my $return;
|
|
$retaincache=1;
|
|
$return->{node}=[noderange($range,$verify)];
|
|
if ($namedopts->{intersectinggroups}) {
|
|
my %grouphash=();
|
|
my $nlent;
|
|
foreach (@{$return->{node}}) {
|
|
$nlent=$nodelist->getNodeAttribs($_,['groups']);
|
|
if ($nlent and $nlent->{groups}) {
|
|
foreach (split /,/,$nlent->{groups}) {
|
|
$grouphash{$_}=1;
|
|
}
|
|
}
|
|
}
|
|
$return->{intersectinggroups}=[sort keys %grouphash];
|
|
}
|
|
$retaincache=0;
|
|
undef ($nodelist);
|
|
@allnodeset=();
|
|
return $return;
|
|
}
|
|
sub abbreviate_noderange {
|
|
#takes a list of nodes or a string and abbreviates
|
|
my $nodes=shift;
|
|
my %grouphash;
|
|
my %sizedgroups;
|
|
my %nodesleft;
|
|
my %targetelems;
|
|
unless (ref $nodes) {
|
|
$nodes = noderange($nodes);
|
|
}
|
|
%nodesleft = map { $_ => 1 } @{$nodes};
|
|
unless ($nodelist) {
|
|
$nodelist =xCAT::Table->new('nodelist',-create =>1);
|
|
}
|
|
my $group;
|
|
foreach($nodelist->getAllAttribs('node','groups')) {
|
|
my @groups=split(/,/,$_->{groups}); #The where clause doesn't guarantee the atom is a full group name, only that it could be
|
|
foreach $group (@groups) {
|
|
push @{$grouphash{$group}},$_->{node};
|
|
}
|
|
}
|
|
|
|
foreach $group (keys %grouphash) {
|
|
#skip single node sized groups, these outliers frequently pasted into non-noderange capable contexts
|
|
if (scalar @{$grouphash{$group}} < 2) { next; }
|
|
push @{$sizedgroups{scalar @{$grouphash{$group}}}},$group;
|
|
}
|
|
my $node;
|
|
use Data::Dumper;
|
|
print Dumper(\%sizedgroups);
|
|
foreach (reverse sort {$a <=> $b} keys %sizedgroups) {
|
|
GROUP: foreach $group (@{$sizedgroups{$_}}) {
|
|
foreach $node (@{$grouphash{$group}}) {
|
|
unless (grep $node eq $_,keys %nodesleft) {
|
|
#this group contains a node that isn't left, skip it
|
|
next GROUP;
|
|
}
|
|
}
|
|
foreach $node (@{$grouphash{$group}}){
|
|
delete $nodesleft{$node};
|
|
}
|
|
$targetelems{$group}=1;
|
|
}
|
|
}
|
|
return (join ',',keys %targetelems,keys %nodesleft);
|
|
}
|
|
|
|
sub noderange {
|
|
$missingnodes=[];
|
|
#We for now just do left to right operations
|
|
my $range=shift;
|
|
my $verify = (scalar(@_) == 1 ? shift : 1);
|
|
unless ($nodelist) {
|
|
$nodelist =xCAT::Table->new('nodelist',-create =>1);
|
|
$nodelist->{_use_cache} = 0; #TODO: a more proper external solution
|
|
$nodelist->_build_cache(['node','groups']);
|
|
$nodelist->{_use_cache} = 1; #TODO: a more proper external solution
|
|
}
|
|
my %nodes = ();
|
|
my %delnodes = ();
|
|
my $op = ",";
|
|
my @elems = split(/(,(?![^[]*?])(?![^\(]*?\)))/,$range); # commas outside of [] or ()
|
|
if (scalar(@elems)==1) {
|
|
@elems = split(/(@(?![^\(]*?\)))/,$range); # only split on @ when no , are present (inner recursion)
|
|
}
|
|
|
|
while (my $atom = shift @elems) {
|
|
if ($atom =~ /^-/) { # if this is an exclusion, strip off the minus, but remember it
|
|
$atom = substr($atom,1);
|
|
$op = $op."-";
|
|
}
|
|
|
|
if ($atom =~ /^\^(.*)$/) { # get a list of nodes from a file
|
|
open(NRF,$1);
|
|
while (<NRF>) {
|
|
my $line=$_;
|
|
unless ($line =~ m/^[\^#]/) {
|
|
$line =~ m/^([^: ]*)/;
|
|
my $newrange = $1;
|
|
chomp($newrange);
|
|
$recurselevel++;
|
|
my @filenodes = noderange($newrange);
|
|
foreach (@filenodes) {
|
|
$nodes{$_}=1;
|
|
}
|
|
}
|
|
}
|
|
close(NRF);
|
|
next;
|
|
}
|
|
|
|
my %newset = map { $_ =>1 } expandatom($atom,$verify); # expand the atom and make each entry in the resulting array a key in newset
|
|
|
|
if ($op =~ /@/) { # compute the intersection of the current atom and the node list we have received before this
|
|
foreach (keys %nodes) {
|
|
unless ($newset{$_}) {
|
|
delete $nodes{$_};
|
|
}
|
|
}
|
|
} elsif ($op =~ /,-/) { # add the nodes from this atom to the exclude list
|
|
foreach (keys %newset) {
|
|
$delnodes{$_}=1; #delay removal to end
|
|
}
|
|
} else { # add the nodes from this atom to the total node list
|
|
foreach (keys %newset) {
|
|
$nodes{$_}=1;
|
|
}
|
|
}
|
|
$op = shift @elems;
|
|
|
|
} # end of main while loop
|
|
|
|
# Now remove all the exclusion nodes
|
|
foreach (keys %nodes) {
|
|
if ($delnodes{$_}) {
|
|
delete $nodes{$_};
|
|
}
|
|
}
|
|
if ($recurselevel) {
|
|
$recurselevel--;
|
|
} else {
|
|
unless ($retaincache) {
|
|
undef $nodelist;
|
|
@allnodeset=();
|
|
}
|
|
}
|
|
return sort (keys %nodes);
|
|
|
|
}
|
|
|
|
|
|
1;
|
|
|
|
=head1 NAME
|
|
|
|
xCAT::NodeRange - Perl module for xCAT noderange expansion
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use xCAT::NodeRange;
|
|
my @nodes=noderange("storage@rack1,node[1-200],^/tmp/nodelist,node300-node400,node401+10,500-550");
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
noderange interprets xCAT noderange formatted strings and returns a list of xCAT nodelists. The following two operations are supported on elements, and interpreted left to right:
|
|
|
|
, union next element with everything to the left.
|
|
|
|
@ take intersection of element to the right with everything on the left (i.e. mask out anything to the left not belonging to what is described to the right)
|
|
|
|
Each element can be a number of things:
|
|
|
|
A node name, i.e.:
|
|
|
|
=item * node1
|
|
|
|
A hyphenated node range (only one group of numbers may differ between the left and right hand side, and those numbers will increment in a base 10 fashion):
|
|
|
|
node1-node200 node1-compute-node200-compute
|
|
node1:node200 node1-compute:node200-compute
|
|
|
|
A noderange denoted by brackets:
|
|
|
|
node[1-200] node[001-200]
|
|
|
|
A regular expression describing the noderange:
|
|
|
|
/d(1.?.?|200)
|
|
|
|
A node plus offset (this increments the first number found in nodename):
|
|
|
|
node1+199
|
|
|
|
And most of the above substituting groupnames.
|
|
3C
|
|
3C
|
|
|
|
NodeRange tries to be intelligent about detecting padding, so you can:
|
|
node001-node200
|
|
And it will increment according to the pattern.
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Jarrod Johnson (jbjohnso@us.ibm.com)
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright 2007 IBM Corp. All rights reserved.
|
|
|
|
|
|
=cut
|