Finished; send a nightly report of illegal symbols found in the Open
MPI libraries and/or components This commit was SVN r2812.
Этот коммит содержится в:
Jeff Squyres
родитель
f82116d806
Коммит
b7c8e307af
@ -8,11 +8,7 @@
|
||||
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
my $prefix = $ARGV[0];
|
||||
if (! $prefix) {
|
||||
die "Must supply the prefix to an Open MPI installation";
|
||||
}
|
||||
use Getopt::Long;
|
||||
|
||||
# Filenames of libraries to look through
|
||||
|
||||
@ -22,72 +18,271 @@ my @lib_suffixes = ('\.so', '\.a');
|
||||
# Filenames of components to look through
|
||||
|
||||
my @comp_prefixes = ("mca_");
|
||||
my @comp_suffices = (".so");
|
||||
my @comp_suffixes = (".so");
|
||||
|
||||
# Acceptable public symbol prefixes
|
||||
|
||||
my @acceptable = ("ompi_" , "mpi_", "MPI_", "OMPI_", "MPI::", "PMPI_", "PMPI::", "mca_", "lt_" );
|
||||
my @lib_acceptable = ("ompi_" , "mpi_", "MPI_", "OMPI_", "MPI::", "PMPI_", "PMPI::", "mca_", "lt_");
|
||||
my @comp_acceptable = ("mca_");
|
||||
|
||||
# Troll through the library directory
|
||||
# Subject line for e-mail
|
||||
|
||||
my $libdir = "$prefix/lib";
|
||||
if (! -d $libdir) {
|
||||
die "libdir does not exist: $libdir";
|
||||
my $subject = "Open MPI Illegal symbol report";
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
# Troll through a list of directories looking for libraries
|
||||
|
||||
sub find_libs {
|
||||
return find_files(\@_, \@lib_prefixes, \@lib_suffixes);
|
||||
}
|
||||
opendir(LIB, $libdir) || die "Unable to open libdir: $libdir";
|
||||
my @dir_files = readdir(LIB);
|
||||
closedir(LIB);
|
||||
|
||||
# Ok, not efficient. Sue me. :-)
|
||||
# Find all the matching files
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
my @found_files;
|
||||
foreach my $prefix (@lib_prefixes) {
|
||||
foreach my $suffix (@lib_suffixes) {
|
||||
foreach my $file (@dir_files) {
|
||||
if ($file =~ /^$prefix.*$suffix$/) {
|
||||
push(@found_files, $file);
|
||||
# Troll through a list of directories looking for components
|
||||
|
||||
sub find_comps {
|
||||
return find_files(\@_, \@comp_prefixes, \@comp_suffixes);
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
sub find_files {
|
||||
my ($dirs, $prefixes, $suffixes) = @_;
|
||||
|
||||
my @found_files;
|
||||
foreach my $dir (@$dirs) {
|
||||
if (! -d $dir) {
|
||||
die "filedir does not exist: $dir";
|
||||
}
|
||||
opendir(DIR, $dir) || die "Unable to open dir: $dir";
|
||||
my @files = readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
# Ok, not efficient. Sue me. :-)
|
||||
# Find all the matching files
|
||||
|
||||
foreach my $prefix (@$prefixes) {
|
||||
foreach my $suffix (@$suffixes) {
|
||||
foreach my $file (@files) {
|
||||
if ($file =~ /^$prefix.*$suffix$/) {
|
||||
push(@found_files, "$dir/$file");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
\@found_files;
|
||||
}
|
||||
|
||||
# Run nm on each of those files looking for global symbols with "bad"
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
# Troll through a list of library files and look for "bad" symbol
|
||||
# names
|
||||
|
||||
my @found_symbols;
|
||||
foreach my $file (@found_files) {
|
||||
open NM, "nm -l -C $libdir/$file|";
|
||||
while (<NM>) {
|
||||
chomp;
|
||||
my ($bogus1, $scope, $symbol, $location) = split(/[ \t]+/, $_);
|
||||
if ($scope =~ /[A-Z]/ &&
|
||||
$scope !~ /[UVW]/ &&
|
||||
$symbol !~ /^_/) {
|
||||
push(@found_symbols, {
|
||||
file => $file,
|
||||
symbol => $symbol,
|
||||
scope => $scope,
|
||||
location => $location,
|
||||
});
|
||||
sub check_libs {
|
||||
return check_files(\@_, \@lib_acceptable);
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
# Troll through a list of component files and look for "bad" symbol
|
||||
# names
|
||||
|
||||
sub check_comps {
|
||||
return check_files(\@_, \@comp_acceptable);
|
||||
}
|
||||
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
sub check_files {
|
||||
my ($files, $acceptable) = @_;
|
||||
my $bad_symbols;
|
||||
|
||||
my $ok;
|
||||
foreach my $file (@$files) {
|
||||
open NM, "nm -l -C $file|";
|
||||
while (<NM>) {
|
||||
chomp;
|
||||
my ($bogus1, $scope, $symbol, $location) = split(/[ \t]+/, $_);
|
||||
|
||||
# Only look for symbols that are a) global [i.e.,
|
||||
# uppercase scope], b) not U, V, or W
|
||||
|
||||
if ($scope =~ /[A-Z]/ &&
|
||||
$scope !~ /[UVW]/ &&
|
||||
$symbol !~ /^_/) {
|
||||
|
||||
$ok = 0;
|
||||
foreach my $prefix (@$acceptable) {
|
||||
if ($symbol =~ /^$prefix/) {
|
||||
$ok = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if (!$ok) {
|
||||
my $line_num;
|
||||
if (!$location) {
|
||||
$location = "Unknown source file";
|
||||
}
|
||||
|
||||
if ($location =~ /src\//) {
|
||||
$location =~ s/.+?\/(src\/)/$1/;
|
||||
}
|
||||
if ($location =~ /:/) {
|
||||
$line_num = $location;
|
||||
$line_num =~ s/.+:([0-9]+)/$1/;
|
||||
$location =~ s/(.+):.+/$1/;
|
||||
}
|
||||
push(@{$bad_symbols->{$file}->{$location}}, {
|
||||
symbol => $symbol,
|
||||
line => $line_num,
|
||||
scope => $scope,
|
||||
});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
\$bad_symbols;
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
# find a program from a list and load it into the target variable
|
||||
sub find_program {
|
||||
my @names = @_;
|
||||
|
||||
# loop through the list and save the first one that we find
|
||||
my $i = 0;
|
||||
while ($i <= $#names) {
|
||||
my $ret = system("which $names[$i] 2>&1 >/dev/null");
|
||||
my $status = $ret >> 8;
|
||||
if ($status == 0) {
|
||||
return $names[$i];
|
||||
}
|
||||
++$i;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
#
|
||||
# main
|
||||
#
|
||||
|
||||
my $mail;
|
||||
|
||||
my @libdir_arg;
|
||||
my @lib_arg;
|
||||
my @compdir_arg;
|
||||
my @comp_arg;
|
||||
my $prefix_arg;
|
||||
my $email_arg;
|
||||
|
||||
# parse the command line
|
||||
&Getopt::Long::Configure("bundling", "require_order");
|
||||
my $ok = Getopt::Long::GetOptions("libdir|l=s" => \@libdir_arg,
|
||||
"lib=s" => \@lib_arg,
|
||||
"compdir|c=s" => \@compdir_arg,
|
||||
"comp=s" => \@comp_arg,
|
||||
"prefix|p=s" => \$prefix_arg,
|
||||
"email|e=s" => \$email_arg,
|
||||
);
|
||||
|
||||
# Check args
|
||||
|
||||
if (!$email_arg) {
|
||||
die "Must have an e-mail argument: specify --email <address>";
|
||||
}
|
||||
if ($#libdir_arg < 0 && $#lib_arg < 0 &&
|
||||
$#compdir_arg < 0 && $#comp_arg < 0 &&
|
||||
!$prefix_arg) {
|
||||
die "Nothing to do!";
|
||||
}
|
||||
|
||||
# Find a mail program
|
||||
|
||||
$mail = find_program(qw(Mail mailx mail));
|
||||
die "Could not find mail program; aborting in despair\n"
|
||||
if (!defined($mail));
|
||||
|
||||
# Look for libraries
|
||||
|
||||
my @libs;
|
||||
if ($prefix_arg) {
|
||||
push(@libdir_arg, "$prefix_arg/lib")
|
||||
if (-d "$prefix_arg/lib");
|
||||
}
|
||||
if ($#libdir_arg >= 0) {
|
||||
my $found = find_libs(@libdir_arg);
|
||||
push(@libs, @$found);
|
||||
}
|
||||
foreach my $dir (@lib_arg) {
|
||||
push(@libs, $dir)
|
||||
if (-f $dir);
|
||||
}
|
||||
|
||||
my $bad_libsymbols = check_libs(@libs);
|
||||
|
||||
# Look for components
|
||||
|
||||
my @comps;
|
||||
if ($prefix_arg) {
|
||||
push(@compdir_arg, "$prefix_arg/lib/openmpi")
|
||||
if (-d "$prefix_arg/lib/openmpi");
|
||||
}
|
||||
if ($#compdir_arg >= 0) {
|
||||
my $found = find_comps(@compdir_arg);
|
||||
push(@comps, @$found);
|
||||
}
|
||||
|
||||
foreach my $dir (@comp_arg) {
|
||||
push(@comps, $dir)
|
||||
if (-f $dir);
|
||||
}
|
||||
|
||||
my $bad_compsymbols = check_comps(@comps);
|
||||
|
||||
# Did we find anything?
|
||||
|
||||
sub mail_symbols {
|
||||
my ($bad, $mail) = @_;
|
||||
|
||||
foreach my $file (sort keys(%{$$bad})) {
|
||||
print $mail "File: $file\n";
|
||||
foreach my $location (sort keys(%{$$bad->{$file}})) {
|
||||
print $mail " Source: $location\n";
|
||||
my $array = $$bad->{$file}->{$location};
|
||||
foreach my $symbol (@$array) {
|
||||
if ($symbol->{line}) {
|
||||
print $mail " --> Line $symbol->{line}: $symbol->{symbol}\n";
|
||||
} else {
|
||||
print $mail " --> $symbol->{symbol}\n";
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
print $mail "\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Now list all the bad ones
|
||||
if ($$bad_compsymbols || $$bad_libsymbols) {
|
||||
|
||||
my $ok;
|
||||
foreach my $symbol (@found_symbols) {
|
||||
$ok = 0;
|
||||
foreach my $prefix (@acceptable) {
|
||||
if ($symbol->{symbol} =~ /^$prefix/) {
|
||||
$ok = 1;
|
||||
}
|
||||
open MAIL, "|$mail -s \"$subject\" \"$email_arg\"" ||
|
||||
die "Could ot open pipe to output e-mail\n";
|
||||
print MAIL "Found global symbols with missing or illegal prefixes\n\n";
|
||||
|
||||
if ($$bad_compsymbols) {
|
||||
mail_symbols($bad_compsymbols, *MAIL{IO});
|
||||
}
|
||||
if (! $ok) {
|
||||
print "$symbol->{file}: $symbol->{symbol}\n";
|
||||
if ($symbol->{location}) {
|
||||
print " --> $symbol->{location}\n";
|
||||
}
|
||||
if ($$bad_libsymbols) {
|
||||
mail_symbols($bad_libsymbols, *MAIL{IO});
|
||||
}
|
||||
|
||||
print MAIL "\nYour friendly server,\nCyrador\n";
|
||||
close MAIL;
|
||||
}
|
||||
|
||||
Загрузка…
x
Ссылка в новой задаче
Block a user