849 lines
22 KiB
Perl
849 lines
22 KiB
Perl
#!/usr/bin/env perl
|
|
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
package xCAT::BuildKitUtils;
|
|
|
|
BEGIN
|
|
{
|
|
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
|
|
}
|
|
|
|
# if AIX - make sure we include perl 5.8.2 in INC path.
|
|
# Needed to find perl dependencies shipped in deps tarball.
|
|
if ($^O =~ /^aix/i) {
|
|
unshift(@INC, qw(/usr/opt/perl5/lib/5.8.2/aix-thread-multi /usr/opt/perl5/lib/5.8.2 /usr/opt/perl5/lib/site_perl/5.8.2/aix-thread-multi /usr/opt/perl5/lib/site_perl/5.8.2));
|
|
}
|
|
|
|
use lib "$::XCATROOT/lib/perl";
|
|
use POSIX qw(ceil);
|
|
use File::Path;
|
|
use Socket;
|
|
use strict;
|
|
use Symbol;
|
|
my $sha1support;
|
|
if ( -f "/etc/debian_version" ) {
|
|
$sha1support = eval {
|
|
require Digest::SHA;
|
|
1;
|
|
};
|
|
}
|
|
else {
|
|
|
|
$sha1support = eval {
|
|
require Digest::SHA1;
|
|
1;
|
|
};
|
|
}
|
|
use IPC::Open3;
|
|
use IO::Select;
|
|
use warnings "all";
|
|
|
|
our @ISA = qw(Exporter);
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head1 xCAT::BuildKitUtils
|
|
|
|
=head2 Package Description
|
|
|
|
This program module file, is a set of utilities used by xCAT buildkit command
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------
|
|
|
|
#--------------------------------------------------------------------------
|
|
=head3 get_latest_version
|
|
|
|
Find the latest version in a list of rpms with the same basename
|
|
|
|
Arguments:
|
|
- the repo location
|
|
- a list of rpms with the same basename
|
|
Returns:
|
|
- name of rpm
|
|
- undef
|
|
Example:
|
|
my $new_d = xCAT::BuildKitUtils->get_latest_version($repodir, \@rpmlist);
|
|
Comments:
|
|
|
|
=cut
|
|
#--------------------------------------------------------------------------
|
|
sub get_latest_version
|
|
{
|
|
my ($class, $repodir, $rpms) = @_;
|
|
|
|
my @rpmlist = @$rpms;
|
|
|
|
my %localversions_hash = ();
|
|
my %file_name_hash = ();
|
|
|
|
my $i = 0;
|
|
foreach my $rpm (@rpmlist)
|
|
{
|
|
|
|
# include path
|
|
my $fullrpmpath = "$repodir/$rpm*";
|
|
|
|
# get the basename, version, and release for this rpm
|
|
my $rcmd = "rpm -qp --queryformat '%{N} %{V} %{R}\n' $repodir/$rpm";
|
|
my $out = `$rcmd`;
|
|
|
|
my ($rpkg, $VERSION, $RELEASE) = split(' ', $out);
|
|
|
|
chomp $VERSION;
|
|
chomp $RELEASE;
|
|
|
|
$localversions_hash{$i}{'VERSION'} = $VERSION;
|
|
$localversions_hash{$i}{'RELEASE'} = $RELEASE;
|
|
|
|
$file_name_hash{$VERSION}{$RELEASE} = $rpm;
|
|
$i++;
|
|
}
|
|
|
|
if ($i == 0)
|
|
{
|
|
print "error\n";
|
|
return undef;
|
|
}
|
|
|
|
my $versionout = "";
|
|
my $releaseout = "";
|
|
$i = 0;
|
|
foreach my $k (keys %localversions_hash)
|
|
{
|
|
if ($i == 0)
|
|
{
|
|
$versionout = $localversions_hash{$k}{'VERSION'};
|
|
$releaseout = $localversions_hash{$k}{'RELEASE'};
|
|
}
|
|
|
|
# if this is a newer version/release then set them
|
|
if ( xCAT::BuildKitUtils->testVersion($localversions_hash{$k}{'VERSION'}, ">", $versionout, $localversions_hash{$k}{'RELEASE'}, $releaseout) ) {
|
|
$versionout = $localversions_hash{$k}{'VERSION'};
|
|
$releaseout = $localversions_hash{$k}{'RELEASE'};
|
|
}
|
|
$i++;
|
|
}
|
|
|
|
if ($i == 0)
|
|
{
|
|
print "Error: Could not determine the latest version for the following list of rpms: @rpmlist\n";
|
|
return undef;
|
|
} else {
|
|
return ($file_name_hash{$versionout}{$releaseout});
|
|
}
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
=head3 find_latest_pkg
|
|
|
|
Find the latest rpm package give the rpm name and a list of
|
|
possible package locations.
|
|
|
|
Arguments:
|
|
- a list of package directories
|
|
- the name of the rpm
|
|
Returns:
|
|
- \@foundrpmlist
|
|
- undef
|
|
Example:
|
|
my $newrpm = xCAT::BuildKitUtils->find_latest_pkg(\@pkgdirs, $rpmname);
|
|
Comments:
|
|
|
|
=cut
|
|
#--------------------------------------------------------------------------
|
|
sub find_latest_pkg
|
|
{
|
|
my ($class, $pkgdirs, $rpmname) = @_;
|
|
my @pkgdirlist = @$pkgdirs;
|
|
|
|
my @rpms;
|
|
my %foundrpm;
|
|
|
|
|
|
# need to check each pkgdir for the rpm(s)
|
|
# - if more than one match need to pick latest
|
|
# find all the matches in all the directories
|
|
foreach my $rpmdir (@pkgdirlist) {
|
|
my $ffile = $rpmdir."/".$rpmname;
|
|
|
|
if ( system("/bin/ls $ffile > /dev/null 2>&1") ){
|
|
# if not then skip to next dir
|
|
next;
|
|
} else {
|
|
# if so then get the details and add it to the %foundrpm hash
|
|
my $cmd = "/bin/ls $ffile 2>/dev/null";
|
|
my $output = `$cmd`;
|
|
my @rpmlist = split(/\n/, $output);
|
|
|
|
if ( scalar(@rpmlist) == 0) {
|
|
# no rpms to check
|
|
next;
|
|
}
|
|
|
|
foreach my $r (@rpmlist) {
|
|
my $rcmd = "rpm -qp --queryformat '%{N} %{V} %{R}\n' $r*";
|
|
my $out = `$rcmd`;
|
|
my ($name, $fromV, $fromR) = split(' ', $out);
|
|
chomp $fromV;
|
|
chomp $fromR;
|
|
|
|
# ex. {ppe_rte_man}{/tmp/rpm1/ppe_rte_man-1.3.0.5-s005a.x86_64.rpm}{version}=$fromV;
|
|
$foundrpm{$name}{$r}{version}=$fromV;
|
|
$foundrpm{$name}{$r}{release}=$fromR;
|
|
|
|
#print "name=$name, full=$r, verson= $fromV, release=$fromR\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
# for each unique rpm basename
|
|
foreach my $r (keys %foundrpm ) {
|
|
# if more than one with same basename then find the latest
|
|
my $latestmatch="";
|
|
foreach my $frpm (keys %{$foundrpm{$r}} ) {
|
|
# if we already found a match in some other dir
|
|
if ($latestmatch) {
|
|
# then we need to figure out which is the newest
|
|
# if the $frpm is newer than use it
|
|
if ( xCAT::BuildKitUtils->testVersion($foundrpm{$r}{$frpm}{version}, ">", $foundrpm{$r}{$latestmatch}{version}, $foundrpm{$r}{$frpm}{release}, $foundrpm{$r}{$latestmatch}{release}) ) {
|
|
$latestmatch = $frpm;
|
|
}
|
|
|
|
} else {
|
|
$latestmatch = $frpm;
|
|
}
|
|
}
|
|
push(@rpms, $latestmatch);
|
|
}
|
|
|
|
if (scalar(@rpms)) {
|
|
return \@rpms;
|
|
} else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
=head3 find_latest_pkg_deb
|
|
|
|
Find the latest deb package give the deb name and a list of
|
|
possible package locations.
|
|
|
|
Arguments:
|
|
- a list of package directories
|
|
- the name of the deb
|
|
Returns:
|
|
- \@founddeblist
|
|
- undef
|
|
Example:
|
|
my $newrpm = xCAT::BuildKitUtils->find_latest_pkg_deb(\@pkgdirs, $debname);
|
|
Comments:
|
|
|
|
=cut
|
|
#--------------------------------------------------------------------------
|
|
sub find_latest_pkg_deb
|
|
{
|
|
my ($class, $pkgdirs, $debname) = @_;
|
|
my @pkgdirlist = @$pkgdirs;
|
|
|
|
my @debs;
|
|
my %founddeb;
|
|
|
|
|
|
# need to check each pkgdir for the deb(s)
|
|
# - if more than one match need to pick latest
|
|
# find all the matches in all the directories
|
|
foreach my $debdir (@pkgdirlist) {
|
|
my $ffile = $debdir."/".$debname;
|
|
|
|
if ( system("/bin/ls $ffile > /dev/null 2>&1") ){
|
|
# if not then skip to next dir
|
|
next;
|
|
} else {
|
|
# if so then get the details and add it to the %founddeb hash
|
|
my $cmd = "/bin/ls $ffile 2>/dev/null";
|
|
my $output = `$cmd`;
|
|
my @deblist = split(/\n/, $output);
|
|
|
|
if ( scalar(@deblist) == 0) {
|
|
next;
|
|
}
|
|
|
|
foreach my $r (@deblist) {
|
|
my $basename = `dpkg -I $r* |grep Package|awk '{print \$2}'`;
|
|
chomp $basename;
|
|
|
|
my $version = `dpkg -I $r* |grep Version|awk '{print \$2}'`;
|
|
print "$basename:$version";
|
|
|
|
$founddeb{$basename}{$r}{version}=$version;
|
|
}
|
|
}
|
|
}
|
|
|
|
# for each unique deb basename
|
|
foreach my $r (keys %founddeb ) {
|
|
# if more than one with same basename then find the latest
|
|
my $latestmatch="";
|
|
foreach my $fdeb (keys %{$founddeb{$r}} ) {
|
|
# if we already found a match in some other dir
|
|
if ($latestmatch) {
|
|
# then we need to figure out which is the newest
|
|
# if the $fdeb is newer than use it
|
|
if ( xCAT::BuildKitUtils->testVersion_deb($founddeb{$r}{$fdeb}{version}, ">", $founddeb{$r}{$latestmatch}{version}) ) {
|
|
$latestmatch = $fdeb;
|
|
}
|
|
|
|
} else {
|
|
$latestmatch = $fdeb;
|
|
}
|
|
}
|
|
push(@debs, $latestmatch);
|
|
}
|
|
|
|
if (scalar(@debs)) {
|
|
return \@debs;
|
|
} else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
|
|
|
|
|
=head3 testVersion_deb
|
|
|
|
Compare version1 and version2 according to the operator and
|
|
return 1 0 or 0.
|
|
|
|
Arguments:
|
|
$version1
|
|
$operator
|
|
$version2
|
|
Returns:
|
|
1 or 0
|
|
Example:
|
|
|
|
Comments:
|
|
The return value is generated with the Require query
|
|
|
|
=cut
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub testVersion_deb
|
|
{
|
|
my ($class, $version1, $operator, $version2) = @_;
|
|
|
|
my $result =`dpkg --compare-versions $version1 $operator $version2`;
|
|
|
|
return $result;
|
|
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
|
|
|
|
|
=head3 testVersion
|
|
|
|
Compare version1 and version2 according to the operator and
|
|
return True or False.
|
|
|
|
Arguments:
|
|
$version1
|
|
$operator
|
|
$version2
|
|
$release1
|
|
$release2
|
|
Returns:
|
|
True or False
|
|
Example:
|
|
|
|
Comments:
|
|
The return value is generated with the Require query of the
|
|
rpm command.
|
|
|
|
=cut
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub testVersion
|
|
{
|
|
my ($class, $version1, $operator, $version2, $release1, $release2) = @_;
|
|
|
|
my @a1 = split(/\./, $version1);
|
|
my @a2 = split(/\./, $version2);
|
|
my $len = (scalar(@a1) > scalar(@a2) ? scalar(@a1) : scalar(@a2));
|
|
$#a1 = $len - 1; # make the arrays the same length before appending release
|
|
$#a2 = $len - 1;
|
|
push @a1, split(/\./, $release1);
|
|
push @a2, split(/\./, $release2);
|
|
$len = (scalar(@a1) > scalar(@a2) ? scalar(@a1) : scalar(@a2));
|
|
my $num1 = '';
|
|
my $num2 = '';
|
|
|
|
for (my $i = 0 ; $i < $len ; $i++)
|
|
{
|
|
# remove any non-numbers on the end
|
|
if(defined($a1[$i])&&defined($a2[$i]))
|
|
{
|
|
my ($d1) = $a1[$i] =~ /^(\d*)/;
|
|
my ($d2) = $a2[$i] =~ /^(\d*)/;
|
|
|
|
my $diff = length($d1) - length($d2);
|
|
if ($diff > 0) # pad d2
|
|
{
|
|
$num1 .= $d1;
|
|
$num2 .= ('0' x $diff) . $d2;
|
|
}
|
|
elsif ($diff < 0) # pad d1
|
|
{
|
|
$num1 .= ('0' x abs($diff)) . $d1;
|
|
$num2 .= $d2;
|
|
}
|
|
else # they are the same length
|
|
{
|
|
$num1 .= $d1;
|
|
$num2 .= $d2;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Remove the leading 0s or perl will interpret the numbers as octal
|
|
$num1 =~ s/^0+//;
|
|
$num2 =~ s/^0+//;
|
|
|
|
# be sure that $num1 is not a "".
|
|
if (length($num1) == 0) { $num1 = 0; }
|
|
if (length($num2) == 0) { $num2 = 0; }
|
|
|
|
if ($operator eq '=') { $operator = '=='; }
|
|
my $bool = eval "$num1 $operator $num2";
|
|
|
|
return $bool;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 isAIX
|
|
returns 1 if localHost is AIX
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
1 - localHost is AIX
|
|
0 - localHost is some other platform
|
|
Globals:
|
|
none
|
|
Error:
|
|
none
|
|
Example:
|
|
if (xCAT::BuildKitUtils->isAIX()) { blah; }
|
|
Comments:
|
|
none
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub isAIX
|
|
{
|
|
if ($^O =~ /^aix/i) { return 1; }
|
|
else { return 0; }
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 get_OS_VRMF
|
|
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
v.r.m.f - if success
|
|
undef - if error
|
|
Example:
|
|
my $osversion = xCAT::BuildKitUtils->get_OS_VRMF();
|
|
Comments:
|
|
Only implemented for AIX for now
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub get_OS_VRMF
|
|
{
|
|
my $version;
|
|
if (xCAT::BuildKitUtils->isAIX()) {
|
|
my $cmd = "/usr/bin/lslpp -cLq bos.rte";
|
|
my $output = `$cmd`;
|
|
chomp($output);
|
|
|
|
# The third field in the lslpp output is the VRMF
|
|
$version = (split(/:/, $output))[2];
|
|
|
|
# not sure if the field would ever contain more than 4 parts?
|
|
my ($v1, $v2, $v3, $v4, $rest) = split(/\./, $version);
|
|
$version = join(".", $v1, $v2, $v3, $v4);
|
|
}
|
|
return (length($version) ? $version : undef);
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 isLinux
|
|
returns 1 if localHost is Linux
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
1 - localHost is Linux
|
|
0 - localHost is some other platform
|
|
Globals:
|
|
none
|
|
Error:
|
|
none
|
|
Example:
|
|
if (xCAT::BuildKitUtils->isLinux()) { blah; }
|
|
Comments:
|
|
none
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub isLinux
|
|
{
|
|
if ($^O =~ /^linux/i) { return 1; }
|
|
else { return 0; }
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 CreateRandomName
|
|
|
|
Create a random file name.
|
|
Arguments:
|
|
Prefix of name
|
|
Returns:
|
|
Prefix with 8 random letters appended
|
|
Error:
|
|
none
|
|
Example:
|
|
$file = xCAT::BuildKitUtils->CreateRandomName($namePrefix);
|
|
Comments:
|
|
None
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub CreateRandomName
|
|
{
|
|
my ($class, $name) = @_;
|
|
|
|
my $nI;
|
|
for ($nI = 0 ; $nI < 8 ; $nI++)
|
|
{
|
|
my $char = ('a' .. 'z', 'A' .. 'Z')[int(rand(52)) + 1];
|
|
$name .= $char;
|
|
}
|
|
$name;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------
|
|
|
|
=head3
|
|
close_delete_file.
|
|
|
|
Arguments:
|
|
file handle,filename
|
|
Returns:
|
|
none
|
|
Globals:
|
|
none
|
|
Error:
|
|
undef
|
|
Example:
|
|
xCAT::BuildKitUtils->close_delete_file($file_handle, $file_name);
|
|
Comments:
|
|
none
|
|
|
|
=cut
|
|
|
|
#------------------------------------------------------------------------
|
|
sub close_delete_file
|
|
{
|
|
my ($class, $file_handle, $file_name) = @_;
|
|
close $file_handle;
|
|
|
|
unlink($file_name);
|
|
}
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 CheckVersion
|
|
Checks the two versions numbers to see which one is greater.
|
|
Arguments:
|
|
ver_a the version number in format of d.d.d.d...
|
|
ver_b the version number in format of d.d.d.d...
|
|
Returns:
|
|
1 if ver_a is greater than ver_b
|
|
0 if ver_a is eaqual to ver_b
|
|
-1 if ver_a is smaller than ver_b
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub CheckVersion
|
|
{
|
|
my $ver_a = shift;
|
|
if ($ver_a =~ /xCAT::BuildKitUtils/)
|
|
{
|
|
$ver_a = shift;
|
|
}
|
|
my $ver_b = shift;
|
|
|
|
my @a = split(/\./, $ver_a);
|
|
my @b = split(/\./, $ver_b);
|
|
my $len_a = @a;
|
|
my $len_b = @b;
|
|
|
|
my $index = 0;
|
|
my $max_index = ($len_a > $len_b) ? $len_a : $len_b;
|
|
|
|
for ($index = 0 ; $index <= $max_index ; $index++)
|
|
{
|
|
my $val_a = ($len_a < $index) ? 0 : $a[$index];
|
|
my $val_b = ($len_b < $index) ? 0 : $b[$index];
|
|
if ($val_a > $val_b) { return 1; }
|
|
if ($val_a < $val_b) { return -1; }
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 osver
|
|
Returns the os and version of the System you are running on
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
0 - ok
|
|
Globals:
|
|
none
|
|
Error:
|
|
1 error
|
|
Example:
|
|
my $os=(xCAT::BuildKitUtils->osver{ ...}
|
|
Comments:
|
|
none
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub osver
|
|
{
|
|
my $osver = "unknown";
|
|
my $os = '';
|
|
my $ver = '';
|
|
my $line = '';
|
|
my @lines;
|
|
my $relfile;
|
|
if (-f "/etc/redhat-release")
|
|
{
|
|
open($relfile,"<","/etc/redhat-release");
|
|
$line = <$relfile>;
|
|
close($relfile);
|
|
chomp($line);
|
|
$os = "rh";
|
|
$ver=$line;
|
|
# $ver=~ s/\.//;
|
|
$ver =~ s/[^0-9]*([0-9.]+).*/$1/;
|
|
if ($line =~ /AS/) { $os = 'rhas' }
|
|
elsif ($line =~ /ES/) { $os = 'rhes' }
|
|
elsif ($line =~ /WS/) { $os = 'rhws' }
|
|
elsif ($line =~ /Server/) { $os = 'rhels' }
|
|
elsif ($line =~ /Client/) { $os = 'rhel' }
|
|
elsif (-f "/etc/fedora-release") { $os = 'rhfc' }
|
|
}
|
|
elsif (-f "/etc/SuSE-release")
|
|
{
|
|
open($relfile,"<","/etc/SuSE-release");
|
|
@lines = <$relfile>;
|
|
close($relfile);
|
|
chomp(@lines);
|
|
if (grep /SLES|Enterprise Server/, @lines) { $os = "sles" }
|
|
if (grep /SLEC/, @lines) { $os = "slec" }
|
|
$ver = $lines[0];
|
|
$ver =~ s/\.//;
|
|
$ver =~ s/[^0-9]*([0-9]+).*/$1/;
|
|
my $minorver;
|
|
if (grep /PATCHLEVEL/, $lines[2]) {
|
|
$minorver = $lines[2];
|
|
$minorver =~ s/PATCHLEVEL[^0-9]*([0-9]+).*/$1/;
|
|
}
|
|
$ver = $ver . ".$minorver" if ( $minorver );
|
|
}
|
|
elsif (-f "/etc/UnitedLinux-release")
|
|
{
|
|
$os = "ul";
|
|
open($relfile,"<","/etc/UnitedLinux-release");
|
|
$ver = <$relfile>;
|
|
close($relfile);
|
|
$ver =~ tr/\.//;
|
|
$ver =~ s/[^0-9]*([0-9]+).*/$1/;
|
|
}
|
|
elsif (-f "/etc/lsb-release") # Possibly Ubuntu
|
|
{
|
|
|
|
if (open($relfile,"<","/etc/lsb-release")) {
|
|
my @text = <$relfile>;
|
|
close($relfile);
|
|
chomp(@text);
|
|
my $distrib_id = '';
|
|
my $distrib_rel = '';
|
|
|
|
foreach (@text) {
|
|
if ( $_ =~ /^\s*DISTRIB_ID=(.*)$/ ) {
|
|
$distrib_id = $1; # last DISTRIB_ID value in file used
|
|
} elsif ( $_ =~ /^\s*DISTRIB_RELEASE=(.*)$/ ) {
|
|
$distrib_rel = $1; # last DISTRIB_RELEASE value in file used
|
|
}
|
|
}
|
|
|
|
if ( $distrib_id =~ /^(Ubuntu|"Ubuntu")\s*$/ ) {
|
|
$os = "ubuntu";
|
|
|
|
if ( $distrib_rel =~ /^(.*?)\s*$/ ) { # eliminate trailing blanks, if any
|
|
$distrib_rel = $1;
|
|
}
|
|
if ( $distrib_rel =~ /^"(.*?)"$/ ) { # eliminate enclosing quotes, if any
|
|
$distrib_rel = $1;
|
|
}
|
|
$ver = $distrib_rel;
|
|
}
|
|
}
|
|
}
|
|
elsif (-f "/etc/debian_version") #possible debian
|
|
{
|
|
if (open($relfile, "<", "/etc/issue")){
|
|
$line = <$relfile>;
|
|
if ( $line =~ /debian.*/i){
|
|
$os = "debian";
|
|
my $relfile1;
|
|
open($relfile1, "<", "/etc/debian_version");
|
|
$ver = <$relfile1>;
|
|
close($relfile1);
|
|
}
|
|
close($relfile);
|
|
}
|
|
}
|
|
$os = "$os" . "," . "$ver";
|
|
return ($os);
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
=head3 acquire_lock
|
|
Get a lock on an arbirtrary named resource. For now, this is only across the scope of one service node/master node, an argument may be added later if/when 'global' locks are supported. This call will block until the lock is free.
|
|
Arguments:
|
|
A string name for the lock to acquire
|
|
Returns:
|
|
false on failure
|
|
A reference for the lock being held.
|
|
=cut
|
|
#-----------------------------------------------------------------------------
|
|
sub acquire_lock {
|
|
my $lock_name = shift;
|
|
use File::Path;
|
|
mkpath("/var/lock/xcat/");
|
|
use Fcntl ":flock";
|
|
my $tlock;
|
|
$tlock->{path}="/var/lock/xcat/".$lock_name;
|
|
open($tlock->{fd},">",$tlock->{path}) or return undef;
|
|
unless ($tlock->{fd}) { return undef; }
|
|
flock($tlock->{fd},LOCK_EX) or return undef;
|
|
return $tlock;
|
|
}
|
|
|
|
#---------------------
|
|
=head3 release_lock
|
|
Release an acquired lock
|
|
Arguments:
|
|
reference to lock
|
|
Returns:
|
|
false on failure, true on success
|
|
=cut
|
|
#-----------------------------------------------------------------------------
|
|
sub release_lock {
|
|
my $tlock = shift;
|
|
unlink($tlock->{path});
|
|
flock($tlock->{fd},LOCK_UN);
|
|
close($tlock->{fd});
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 get_unique_members
|
|
Description:
|
|
Return an array which have unique members
|
|
|
|
Arguments:
|
|
origarray: the original array to be treated
|
|
Returns:
|
|
Return an array, which contains unique members.
|
|
Globals:
|
|
none
|
|
Error:
|
|
none
|
|
Example:
|
|
my @new_array = xCAT::BuildKitUtils::get_unique_members(@orig_array);
|
|
Comments:
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub get_unique_members
|
|
{
|
|
my @orig_array = @_;
|
|
my %tmp_hash = ();
|
|
for my $ent (@orig_array)
|
|
{
|
|
$tmp_hash{$ent} = 1;
|
|
}
|
|
return keys %tmp_hash;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
=head3 full_path
|
|
Description:
|
|
Convert the relative path to full path.
|
|
|
|
Arguments:
|
|
relpath: relative path
|
|
cwdir: current working directory, use the cwd() if not specified
|
|
Returns:
|
|
Return the full path
|
|
NULL - Failed to get the full path.
|
|
Globals:
|
|
none
|
|
Error:
|
|
none
|
|
Example:
|
|
my $fp = xCAT::BuildKitUtils::full_path('./test', '/home/guest');
|
|
Comments:
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------------------
|
|
sub full_path
|
|
{
|
|
my ($class, $relpath, $cwdir) = @_;
|
|
|
|
my $fullpath;
|
|
|
|
if (!$cwdir) { #cwdir is not specified
|
|
$fullpath = Cwd::abs_path($relpath);
|
|
} else {
|
|
$fullpath = $cwdir . "/$relpath";
|
|
}
|
|
|
|
return $fullpath;
|
|
}
|
|
|
|
1;
|