core/sqf/sqvers

#!/usr/bin/perl

# @@@ START COPYRIGHT @@@
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.
#
# @@@ END COPYRIGHT @@@

use strict;
use warnings;

use Getopt::Long;

# forwards
sub find_elfs ($$);
sub find_jars ($);

# globals
my $detail = 0;
my $help = 0;
my $res;
my $utt = 0;
my $verbose = 0;
my %version_table_patch;
my %version_table_utt;

# main start
$res = GetOptions(
	'd' => \$detail,
	'h' => \$help,
	'u' => \$utt,
	'v' => \$verbose,
	);
my $prog = $0;
$prog =~ s/^.*\///;
if (!$res) {
	print_usage();
	exit(1);
} else {
	if ($help) {
		print_usage();
		exit(0);
	}
}

# get TRAF_HOME/who/host
my $sq_pdsh = defined $ENV{'SQ_PDSH'} ? $ENV{'SQ_PDSH'} : '';
my $traf_home = defined $ENV{'TRAF_HOME'} ? $ENV{'TRAF_HOME'} : '';
my $java_home = defined $ENV{'JAVA_HOME'} ? $ENV{'JAVA_HOME'} : '';
my $sq_mbtype = defined $ENV{'SQ_MBTYPE'} ? $ENV{'SQ_MBTYPE'} : '';
my $host;
gethost();
my $mtype;
my $btype;
getmbtype();

if ($verbose) {
	printf "v: cmd:whoami\n";
}
my $w = `whoami`;
$w =~ s/\s+$//;

if ($verbose) {
	printf "v: cmd:uname -r\n";
}
my $lr = `uname -r`;
$lr =~ s/\s+$//;

my $linuxdistro = "UnknownLinuxDistro";
my $dr = "?.?";
if (-r "/etc/redhat-release") {
    if ($verbose) {
	printf "v: cmd:cat /etc/redhat-release\n";
    }
    $linuxdistro = "redhat";
    my $linuxrel = `cat /etc/redhat-release`;
    if ($linuxrel =~ /^.*release ([0-9][0-9]*)\.([0-9][0-9]*)/) {
	$dr=$1 . "." . $2
    }
} elsif (-r "/etc/SuSE-release") {
    if ($verbose) {
	printf "v: cmd:cat /etc/SuSE-release\n";
    }
    $linuxdistro = "SuSE";
    my $susevers = `cat /etc/SuSE-release | grep VERSION | cut -f 2 -d '='`;
    my $susepatch = `cat /etc/SuSE-release | grep PATCH | cut -f 2 -d '='`;
    # trim white space
    $susevers =~ s/^\s+|\s+$//g;
    $susepatch =~ s/^\s+|\s+$//g;
    $dr=$susevers . "." . $susepatch
}

print "TRAF_HOME=$traf_home\n";
print "who\@host=$w\@$host\n";
print "JAVA_HOME=$java_home\n";
# can't do much if these two env variables are not setup
if (!defined $ENV{'TRAF_HOME'}) {
	die "TRAF_HOME is not set!";
}
if (!defined $ENV{'JAVA_HOME'}) {
	die "JAVA_HOME is not set!";
}

# only print SQ_MBTYPE if NOT 64(release)
if (($mtype =~ /32/) || ($btype =~ /debug/)) {
	print "SQ_MBTYPE=$sq_mbtype ($mtype-$btype)\n";
}
print "linux=$lr\n";
print "$linuxdistro=$dr\n";

# deal with elfs
my $dir_lib = "export/lib" . $sq_mbtype;
find_elfs($dir_lib, 0);
my $dir_bin = "export/bin" . $sq_mbtype;
find_elfs($dir_bin, 0);

# deal with jars
find_jars("export/lib");

if ($utt) {
	utt_print();
}

sub find_elfs ($$) {
	my ($dir, $so) = @_;
	my $chdir = "$traf_home/$dir";
	chdir($chdir) or die "can't chdir to $chdir $!";
	my $ls;
	if ($so) {
		$ls = `ls *.so`;
	} else {
		$ls = `ls`;
	}
	my @files = split(/\n/, $ls);
	my $file;
	foreach $file (@files) {
		my $dochk = 1;
		if ($file =~ /sqlite3/) {
			$dochk = 0;
		}
		if ($file =~ /libudis86.so/) {
			$dochk = 0;
		}
		if ($file =~ /libudis86.so.0/) {
			$dochk = 0;
		}
		if ($file =~ /libjit.so/) {
			$dochk = 0;
		}
		if ($file =~ /libACE.so/) {
			$dochk = 0;
		}
		if ($file =~ /libQtCoreCmpDbg.so.4/) {
			$dochk = 0;
		}
		if ($file =~ /libQtGuiCmpDbg.so.4/) {
			$dochk = 0;
		}
		if ($file =~ /libhdfs.so|libhadoop.so|libmysql|libthrift|libzookeeper|libcurl|^liblog4cxx|^libicu/) {
			$dochk = 0;
		}
		if ($file =~ /mpirun|hydra_pmi_proxy/) {
			$dochk = 0;
		}
		if ($dochk) {
			my $chk = `file -L $file`;
			if ($chk =~ /ELF/) {
				version_elf($dir, $file);
			}
		}
	}
}

sub find_jars ($) {
	my ($dir) = @_;
	my $chdir = "$traf_home/$dir";
	chdir($chdir) or die "can't chdir to $chdir $!";
	my $ls = `ls *.jar`;
	my @files = split(/\n/, $ls);
	my $file;
	foreach $file (@files) {
		my $dochk = 1;
		if ($dochk) {
			version_jar($dir, $file);
		}
	}
}

#
# gethost
#   default to hostname
#   search /etc/pdsh/machines | /opt/hptc/pdsh/nodes for non 'n[0-9][0-9]*'
#
sub gethost {
	if ($verbose) {
		printf "v: cmd:hostname\n";
	}
	$host = `hostname`;
	$host =~ s/\s+$//;
	if (-x ($sq_pdsh)) {
		# find head node
		if ($verbose) {
			printf "v: cmd:cat /etc/pdsh/machines\n";
		}
		my $mach;
		if (-r "/etc/pdsh/machines") {
			$mach = `cat /etc/pdsh/machines`;
		} elsif (-r "/etc/machines") {
			$mach = `cat /etc/machines`;
		} else {
			$mach = `cat /opt/hptc/pdsh/nodes`;
		}
		my @nstrs = split(/\n/, $mach);
		my $nstr;
		foreach $nstr (@nstrs) {
			my $hno = $nstr;
			$hno =~ s/\s+$//;
			if ($verbose) {
				print "v: /etc/pdsh/machines, rec=$hno\n";
			}
			if ($hno !~ /^n[0-9][0-9]*/) {
				$host = $hno;
				last;
			}
		}
	}
	if ($verbose) {
		print "v: *host=$host\n";
	}
	$host =~ s/\s+$//;
}

sub getmbtype {
	$mtype = "unknown";
	$btype = "unknown";
	if ($sq_mbtype =~ /^([0-9][0-9])/) {
		$mtype = "$1";
	}
	if ($sq_mbtype =~ /d/) {
		$btype = "debug";
	} else {
		$btype = "release";
	}
}

#
# Print Patch node
#
sub patch_print_node ($) {
	my ($vers_key) = @_;
	my $node_patch = $version_table_patch{$vers_key};
	my $vers = $node_patch->get_vers();
	my $count = $node_patch->get_count();
	my @list = $node_patch->get_list();
	print "[$count]\t$vers\n";
	my $list_key;
	foreach $list_key (@list) {
		print "\t  $list_key\n";
	}
}

sub print_usage {
	printf "usage: $prog [-d] [-h] [-u] [-v]\n";
	printf "  -d: detail (used with -u)\n";
	printf "  -h: display help\n";
	printf "  -u: display UTTs\n";
	printf "  -v: verbose\n";
}

sub version_elf ($$) {
	my ($dir, $elf) = @_;

	if ($verbose) {
		printf "v: cmd:nm $elf\n";
	}
	my $nm = `nm $elf | grep " VERS_"`;
	my @strs = split(/\n/, $nm);
	my $str;
	my $has_version = 0;
	foreach $str (@strs) {
		my $ver = $str;
		$ver =~ s/^.*?VERS_//;
		$ver =~ s/_sl_/\//g;
		$ver =~ s/_dt_/\./g;
		$ver =~ s/_dh_/-/g;
		if ($ver =~ /([a-zA-Z0-9_]*)_CV(\d*)_(\d*)_(\d*)_PV(\d*)_(\d*)_(\d*)_(\w*)_BV(\w*)_BR([\w\-\.\/]*)_DT(\w*)_SV(.*)/) {
			$has_version = 1;
			my $verstr = "$8 Release $5.$6.$7 (Build $9 [$12], branch $10, date $11)";
			my $bldstr = $12;
			if ($utt) {
				utt_add($dir, $elf, $verstr, $bldstr);
			} else {
				print "$elf $1 Version $2.$3.$4 $verstr\n";
			}
		}
	}
	if (!$has_version) {
		print "\$TRAF_HOME/$dir/$elf missing version string\n";
	}
}

sub version_jar ($$) {
	my ($dir, $jar) = @_;

	my $cmd_vers = "$java_home/bin/java -jar $traf_home/export/lib/sqmanvers.jar $jar";
	if ($verbose) {
		printf "v: cmd:$cmd_vers\n";
	}
	my $vers = `$cmd_vers 2>/dev/null`;
	my @strs = split(/\n/, $vers);
	my $str;
	my $has_version = 0;
	foreach $str (@strs) {
		my $ver = $str;
		if ($ver =~ /^Version (\d*)\.(\d*)\.(\d*) (.*)/) {
			$has_version = 1;
			my $v1 = $1;
			my $v2 = $2;
			my $v3 = $3;
			my $verstr = $4;
			my $bldstr;
			if ($verstr =~ /\(Build [a-z]+ \[([a-zA-Z0-9_-]*)\].*/) {
				$bldstr = $1;
			} else {
				$bldstr = $verstr;
			}
			if ($utt) {
				utt_add($dir, $jar, $verstr, $bldstr);
			} else {
				print "$jar Version $v1.$v2.$v3 $verstr\n";
			}
		}
	}
	
	if (!$utt && !$has_version) {
		print "\$TRAF_HOME/$dir/$jar missing version string\n";
	}
}

#
# Add utt to version_table_utt
#
sub utt_add ($$$$) {
	my ($dir, $elf, $vers, $buildid) = @_;

	if ($buildid =~ /(BUGFIX_[0-9_-]+)/) {
		my $patch = $1;
		my $node_patch;
		if (exists $version_table_patch{$patch}) {
			$node_patch = $version_table_patch{$patch};
			$node_patch->add($dir, $elf);
		} else {
			$node_patch = new Node($dir, $elf, $vers);
			$version_table_patch{$patch} = $node_patch;
		}
	} else {
		my $node_utt;
		if (exists $version_table_utt{$vers}) {
			$node_utt = $version_table_utt{$vers};
			$node_utt->add($dir, $elf);
		} else {
			$node_utt = new Node($dir, $elf, $vers);
			$version_table_utt{$vers} = $node_utt;
		}
	}
}

#
# Print UTTs
#
sub utt_print {
	my $vers_key;
	my $vers_count_patch = keys %version_table_patch;
	my $vers_count_utt = keys %version_table_utt;
	my $vers;
	if ($vers_count_patch < 1) {
		printf "NO patches\n";
	}

	if ($vers_count_utt <= 1) {
		if ($vers_count_patch > 0) {
			printf "Patch count is $vers_count_patch\n";
			foreach $vers_key (sort keys %version_table_patch) {
				patch_print_node($vers_key);
			}
		}

		my @list = %version_table_utt;
		printf "NO UTTs - $list[0]\n";
		return;
	}
	if ($detail) {
		printf "ALL versions displayed\n";

		printf "Patch count is $vers_count_patch\n";
		foreach $vers_key (sort keys %version_table_patch) {
			patch_print_node($vers_key);
		}

		printf "UTT count is $vers_count_utt\n";
		foreach $vers_key (sort keys %version_table_utt) {
			utt_print_node($vers_key);
		}
	} else {
		if ($vers_count_patch > 0) {
			printf "Patch count is $vers_count_patch\n";
			foreach $vers_key (sort keys %version_table_patch) {
				patch_print_node($vers_key);
			}
		}

		my $max = 0;
		my $max_vers = 0;
		foreach $vers_key (sort keys %version_table_utt) {
			my $node_utt = $version_table_utt{$vers_key};
			my $count = $node_utt->get_count();
			if ($count > $max) {
				$max = $count;
				$max_vers = $node_utt->get_vers();
			}
		}
		my $print_count = $vers_count_utt - 1;
		printf "Most common $max_vers\n";
		printf "UTT count is $print_count\n";
		foreach $vers_key (sort keys %version_table_utt) {
			my $node_utt = $version_table_utt{$vers_key};
			$vers = $node_utt->get_vers();
			if ($vers ne $max_vers) {
				utt_print_node($vers_key);
			}
		}
	}
}

#
# Print UTT node
#
sub utt_print_node ($) {
	my ($vers_key) = @_;
	my $node_utt = $version_table_utt{$vers_key};
	my $vers = $node_utt->get_vers();
	my $count = $node_utt->get_count();
	my @list = $node_utt->get_list();
	print "[$count]\t$vers\n";
	my $list_key;
	foreach $list_key (@list) {
		print "\t  $list_key\n";
	}
}

#
# Node object
#
package Node;
sub new {
	my $class = shift;
	my @list = ();
	my $list_r = \@list;
	my $self = {
		_dir => shift,
		_elf => shift,
		_version => shift,
		_count => 1,
		_list => $list_r,
	};
	my $dir = $self->{_dir};
	my $elf = $self->{_elf};
	my $list = $self->{_list};
	push(@{$list}, "$dir/$elf");
	bless $self, $class;
	return $self;
}
sub add {
	my ($self, $dir, $elf) = @_;
	$self->{_count}++;
	my $list = $self->{_list};
	push(@{$list}, "$dir/$elf");
}
sub get_count {
	my ($self) = @_;
	return $self->{_count};
}
sub get_list {
	my ($self) = @_;
	my $list = $self->{_list};
	return @{$list};
}
sub get_vers {
	my ($self) = @_;
	return $self->{_version};
}