318 строки
8.0 KiB
Perl
Исполняемый файл
318 строки
8.0 KiB
Perl
Исполняемый файл
#!/usr/bin/env perl
|
|
#
|
|
# $HEADER$
|
|
#
|
|
# Look for public symbols in Open MPI libraries and components that
|
|
# are "bad"
|
|
#
|
|
|
|
use strict;
|
|
use Data::Dumper;
|
|
use Getopt::Long;
|
|
|
|
# Filenames of libraries to look through
|
|
|
|
my @lib_prefixes = ("libmpi", "libmca" );
|
|
my @lib_suffixes = ('\.so', '\.a');
|
|
|
|
# Filenames of components to look through
|
|
|
|
my @comp_prefixes = ("mca_");
|
|
my @comp_suffixes = (".so");
|
|
|
|
# Acceptable public symbol prefixes
|
|
|
|
my @lib_acceptable = ("ompi_" , "mpi_", "MPI_", "OMPI_", "MPI::", "PMPI_", "PMPI::", "mca_", "lt_");
|
|
my @comp_acceptable = ("mca_");
|
|
|
|
# Subject line for e-mail
|
|
|
|
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);
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
|
|
# 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;
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
|
|
# Troll through a list of library files and look for "bad" symbol
|
|
# names
|
|
|
|
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;
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
|
|
# 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";
|
|
}
|
|
}
|
|
|
|
#--------------------------------------------------------------------------
|
|
|
|
#
|
|
# main
|
|
#
|
|
|
|
my $mail;
|
|
|
|
my @libdir_arg;
|
|
my @lib_arg;
|
|
my @compdir_arg;
|
|
my @comp_arg;
|
|
my $prefix_arg;
|
|
my $email_arg;
|
|
my $delete_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,
|
|
"delete" => \$delete_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);
|
|
|
|
if ($$bad_compsymbols || $$bad_libsymbols) {
|
|
|
|
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 ($$bad_libsymbols) {
|
|
mail_symbols($bad_libsymbols, *MAIL{IO});
|
|
}
|
|
|
|
print MAIL "\nYour friendly server,\nCyrador\n";
|
|
close MAIL;
|
|
}
|
|
|
|
# If --delete was given, remove all the dirs and files listed on the
|
|
# command line -- ignore any errors in case subdirectories were given.
|
|
|
|
if ($delete_arg) {
|
|
foreach my $file (@lib_arg) {
|
|
system("rm -rf $file >/dev/null 2>/dev/null");
|
|
}
|
|
foreach my $file (@comp_arg) {
|
|
system("rm -rf $file >/dev/null 2>/dev/null");
|
|
}
|
|
foreach my $file (@libdir_arg) {
|
|
system("rm -rf $file >/dev/null 2>/dev/null");
|
|
}
|
|
foreach my $file (@compdir_arg) {
|
|
system("rm -rf $file >/dev/null 2>/dev/null");
|
|
}
|
|
if ($prefix_arg) {
|
|
system("rm -rf $prefix_arg >/dev/null 2>/dev/null");
|
|
}
|
|
}
|
|
|
|
# All done
|
|
|
|
exit(0);
|