|
| 1 | +#!/usr/bin/env perl |
| 2 | + |
| 3 | +# Copyright (c) 2020 IBM Corporation. All rights reserved. |
| 4 | + |
| 5 | +sub identify_mpi_libraries_for_executable { |
| 6 | + my $exe = $_[0]; |
| 7 | + my $cmd; |
| 8 | + my @tmp; |
| 9 | + my @line; |
| 10 | + my @libs; |
| 11 | + my $lib; |
| 12 | + my $dir; |
| 13 | + my $mpidir; |
| 14 | + my %libs_dir; |
| 15 | + |
| 16 | + %libs_dir = (); |
| 17 | + @tmp = split(/\n/, `ldd $exe 2>/dev/null`); |
| 18 | + for $line (@tmp) { |
| 19 | + if ($line =~ /^.* => *([^ (]*)/) { |
| 20 | + $lib = $1; |
| 21 | + if ($lib =~ m#(.*)/([^/]*)#) { |
| 22 | + $dir = $1; |
| 23 | + if (! -z "$dir" && -d "$dir") { |
| 24 | + $dir = `cd $dir ; pwd`; chomp $dir; |
| 25 | + $libs_dir{$2} = $dir; |
| 26 | + } |
| 27 | + } |
| 28 | + } |
| 29 | + } |
| 30 | + |
| 31 | + # One of these libraries should be libmpi.so or libmpi_something.so |
| 32 | + # and we'll keep every lib that's in the same directory as that lib |
| 33 | + $mpidir = ''; |
| 34 | + for $lib (keys(%libs_dir)) { |
| 35 | + if ($lib =~ /libmpi_.*\./) { |
| 36 | + $mpidir = $libs_dir{$lib}; |
| 37 | + } |
| 38 | + } |
| 39 | + for $lib (keys(%libs_dir)) { |
| 40 | + if ($lib =~ /libmpi\./) { |
| 41 | + $mpidir = $libs_dir{$lib}; |
| 42 | + } |
| 43 | + } |
| 44 | + @libs = (); |
| 45 | + for $lib (keys(%libs_dir)) { |
| 46 | + if ($libs_dir{$lib} eq $mpidir) { |
| 47 | + push(@libs, "$mpidir/$lib"); |
| 48 | + } |
| 49 | + } |
| 50 | + |
| 51 | + # Update: in SMPI at least we also put libevent in our <mpi_root>/lib |
| 52 | + # and even though those symbols could be a problem too, I lean toward |
| 53 | + # not caling them out here. |
| 54 | + @libs = grep(!/^libevent/, @libs); |
| 55 | + |
| 56 | + # I don't want to hard-code too much into this, but I'd like |
| 57 | + # to artificually make sure the fortran libraries are checked |
| 58 | + # and those wouldn't naturally show up for a C program. |
| 59 | + @tmp = split(/\n/, `cd $mpidir ; ls libmpi*_mpifh.so libmpi*_usempi.so libmpi_usempi_ignore_tkr.so libmpi_usempif08.so 2>/dev/null`); |
| 60 | + for $lib (@tmp) { |
| 61 | + if (-e "$mpidir/$lib") { |
| 62 | + push(@libs, "$mpidir/$lib"); |
| 63 | + } |
| 64 | + } |
| 65 | + |
| 66 | + # print join("\n", @libs), "\n"; |
| 67 | + |
| 68 | + return(@libs); |
| 69 | +} |
| 70 | + |
| 71 | +sub main { |
| 72 | + $x = @ARGV[0]; |
| 73 | + if (! -e "$x") { |
| 74 | + print("One argument required: MPI executable\n"); |
| 75 | + exit(-1); |
| 76 | + } |
| 77 | + @libs = identify_mpi_libraries_for_executable($x); |
| 78 | + |
| 79 | + print "Checking for bad symbol names:\n"; |
| 80 | + $isbad = 0; |
| 81 | + for $lib (@libs) { |
| 82 | + print "*** checking $lib\n"; |
| 83 | + check_lib_for_bad_exports($lib); |
| 84 | + } |
| 85 | + if ($isbad) { exit(-1); } |
| 86 | +} |
| 87 | + |
| 88 | +sub check_lib_for_bad_exports { |
| 89 | + my $lib = $_[0]; |
| 90 | + my @symbols; |
| 91 | + my $s; |
| 92 | + |
| 93 | + @symbols = get_nm($lib, 'all'); |
| 94 | + |
| 95 | + # grep to get rid of symbol prefixes that are considered acceptable, |
| 96 | + # leaving behind anything bad: |
| 97 | + @symbols = grep(!/^ompi_/i, @symbols); |
| 98 | + @symbols = grep(!/^ompix_/i, @symbols); |
| 99 | + @symbols = grep(!/^opal_/i, @symbols); |
| 100 | + @symbols = grep(!/^orte_/i, @symbols); |
| 101 | + @symbols = grep(!/^orted_/i, @symbols); |
| 102 | + @symbols = grep(!/^oshmem_/i, @symbols); |
| 103 | + @symbols = grep(!/^mpi_/i, @symbols); |
| 104 | + @symbols = grep(!/^mpix_/i, @symbols); |
| 105 | + @symbols = grep(!/^mpiext_/i, @symbols); |
| 106 | + @symbols = grep(!/^pmpi_/i, @symbols); |
| 107 | + @symbols = grep(!/^pmpix_/i, @symbols); |
| 108 | + @symbols = grep(!/^pmix_/i, @symbols); |
| 109 | + @symbols = grep(!/^pmix2x_/i, @symbols); |
| 110 | + @symbols = grep(!/^PMI_/i, @symbols); |
| 111 | + @symbols = grep(!/^PMI2_/i, @symbols); |
| 112 | + @symbols = grep(!/^MPIR_/, @symbols); |
| 113 | + @symbols = grep(!/^MPIX_/, @symbols); |
| 114 | + @symbols = grep(!/^mpidbg_dll_locations$/, @symbols); |
| 115 | + @symbols = grep(!/^mpimsgq_dll_locations$/, @symbols); |
| 116 | + @symbols = grep(!/^ompit_/i, @symbols); |
| 117 | + @symbols = grep(!/^ADIO_/i, @symbols); |
| 118 | + @symbols = grep(!/^ADIOI_/i, @symbols); |
| 119 | + @symbols = grep(!/^MPIO_/i, @symbols); |
| 120 | + @symbols = grep(!/^MPIOI_/i, @symbols); |
| 121 | + @symbols = grep(!/^MPIU_/i, @symbols); |
| 122 | + @symbols = grep(!/^NBC_/i, @symbols); # seems sketchy to me |
| 123 | + @symbols = grep(!/^mca_/, @symbols); |
| 124 | + @symbols = grep(!/^smpi_/, @symbols); |
| 125 | + |
| 126 | + @symbols = grep(!/^_fini$/, @symbols); |
| 127 | + @symbols = grep(!/^_init$/, @symbols); |
| 128 | + @symbols = grep(!/^_edata$/, @symbols); |
| 129 | + @symbols = grep(!/^_end$/, @symbols); |
| 130 | + @symbols = grep(!/^__bss_start$/, @symbols); |
| 131 | + @symbols = grep(!/^__malloc_initialize_hook$/, @symbols); |
| 132 | + |
| 133 | + # Fortran compilers can apparently put some odd symbols in through |
| 134 | + # no fault of OMPI code. I've at least seen "D &&N&mpi_types" created |
| 135 | + # by xlf from module mpi_types. What we're trying to catch with this |
| 136 | + # testcase are OMPI bugs that need fixed, and I don't think OMPI is |
| 137 | + # likely to be creating such symbols through other means, so I'm |
| 138 | + # inclined to ignore any non-typical starting char as long as it's |
| 139 | + # in one of the fortran libs. |
| 140 | + if ($lib =~ /libmpi.*_usempi\./ || |
| 141 | + $lib =~ /libmpi.*_usempi_ignore_tkr\./ || |
| 142 | + $lib =~ /libmpi.*_usempif08\./) |
| 143 | + { |
| 144 | + @symbols = grep(!/^[^a-zA-Z0-9_]/, @symbols); |
| 145 | + |
| 146 | + @symbols = grep(!/^__mpi_/, @symbols); |
| 147 | + @symbols = grep(!/^_mpi_/, @symbols); |
| 148 | + @symbols = grep(!/^__pmpi_/, @symbols); |
| 149 | + @symbols = grep(!/^_pmpi_/, @symbols); |
| 150 | + @symbols = grep(!/^__mpiext_/, @symbols); |
| 151 | + @symbols = grep(!/^_mpiext_/, @symbols); |
| 152 | + @symbols = grep(!/^__ompi_/, @symbols); |
| 153 | + @symbols = grep(!/^_ompi_/, @symbols); |
| 154 | + @symbols = grep(!/^pompi_buffer_detach/, @symbols); |
| 155 | + } |
| 156 | + |
| 157 | + if ($lib =~ /libpmix\./) { |
| 158 | + # I'm only making this exception since the construct_dictionary.py |
| 159 | + # that creates dictionary.h is in a separate pmix repot. |
| 160 | + @symbols = grep(!/^dictionary$/, @symbols); |
| 161 | + } |
| 162 | + |
| 163 | + for $s (@symbols) { |
| 164 | + print " [error] $s\n"; |
| 165 | + $isbad = 1; |
| 166 | + } |
| 167 | +} |
| 168 | + |
| 169 | +# get_nm /path/to/some/libfoo.so <func|wfunc|all> |
| 170 | + |
| 171 | +sub get_nm { |
| 172 | + my $lib = $_[0]; |
| 173 | + my $mode = $_[1]; |
| 174 | + my $search_char; |
| 175 | + my @tmp; |
| 176 | + my @symbols; |
| 177 | + |
| 178 | + $search_char = "TWBCDVR"; |
| 179 | + if ($mode eq 'func') { $search_char = "T"; } |
| 180 | + if ($mode eq 'wfunc') { $search_char = "W"; } |
| 181 | + |
| 182 | + @symbols = (); |
| 183 | + @tmp = split(/\n/, `nm $lib 2>/dev/null`); |
| 184 | + for $line (@tmp) { |
| 185 | + if ($line =~ /.* [$search_char] +([^ ]*)/) { |
| 186 | + push(@symbols, $1); |
| 187 | + } |
| 188 | + } |
| 189 | + |
| 190 | + @symbols = sort(@symbols); |
| 191 | + # print join("\n", @symbols), "\n"; |
| 192 | + |
| 193 | + return(@symbols); |
| 194 | +} |
| 195 | + |
| 196 | +main(); |
0 commit comments