1#!/usr/bin/perl -ws 2 3# 4# findrfuncs: find reentrant variants of functions used in an executable. 5# 6# Requires a functional "nm -u". Searches headers in /usr/include 7# to find available *_r functions and looks for non-reentrant 8# variants used in the supplied executable. 9# 10# Requires debug info in the shared libraries/executables. 11# 12# Gurusamy Sarathy 13# gsar@ActiveState.com 14# 15# Hacked to automatically find the executable and shared objects. 16# --jhi 17 18use strict; 19use File::Find; 20 21my @EXES; 22my $NMU = 'nm -u'; 23my @INCDIRS = qw(/usr/include); 24my $SO = 'so'; 25my $EXE = ''; 26 27if (open(CONFIG, "config.sh")) { 28 local $/; 29 my $CONFIG = <CONFIG>; 30 $SO = $1 if $CONFIG =~ /^so='(\w+)'/m; 31 $EXE = $1 if $CONFIG =~ /^_exe='\.(\w+)'/m; 32 close(CONFIG); 33} 34 35push @EXES, "perl$EXE"; 36 37find(sub {push @EXES, $File::Find::name if /\.$SO$/}, '.' ); 38 39push @EXES, @ARGV; 40 41if ($^O eq 'dec_osf') { 42 $NMU = 'nm -Bu'; 43} elsif ($^O eq 'irix') { 44 $NMU = 'nm -pu'; 45} 46 47my %rfuncs; 48my @syms; 49find(sub { 50 return unless -f $File::Find::name; 51 local *F; 52 open F, "<$File::Find::name" 53 or die "Can't open $File::Find::name: $!"; 54 my $line; 55 while (defined ($line = <F>)) { 56 if ($line =~ /\b(\w+_r)\b/) { 57 #warn "$1 => $File::Find::name\n"; 58 $rfuncs{$1}->{$File::Find::name}++; 59 } 60 } 61 close F; 62 }, @INCDIRS); 63 64# delete bogus symbols grepped out of comments and such 65delete $rfuncs{setlocale_r} if $^O eq 'linux'; 66 67# delete obsolete (as promised by man pages) symbols 68my $netdb_r_obsolete; 69if ($^O eq 'hpux') { 70 delete $rfuncs{crypt_r}; 71 delete $rfuncs{drand48_r}; 72 delete $rfuncs{endgrent_r}; 73 delete $rfuncs{endpwent_r}; 74 delete $rfuncs{getgrent_r}; 75 delete $rfuncs{getpwent_r}; 76 delete $rfuncs{setlocale_r}; 77 delete $rfuncs{srand48_r}; 78 delete $rfuncs{strerror_r}; 79 $netdb_r_obsolete = 1; 80} elsif ($^O eq 'dec_osf') { 81 delete $rfuncs{crypt_r}; 82 delete $rfuncs{strerror_r}; 83 $netdb_r_obsolete = 1; 84} 85if ($netdb_r_obsolete) { 86 delete @rfuncs{qw(endhostent_r 87 endnetent_r 88 endprotoent_r 89 endservent_r 90 gethostbyaddr_r 91 gethostbyname_r 92 gethostent_r 93 getnetbyaddr_r 94 getnetbyname_r 95 getnetent_r 96 getprotobyname_r 97 getprotobynumber_r 98 getprotoent_r 99 getservbyname_r 100 getservbyport_r 101 getservent_r 102 sethostent_r 103 setnetent_r 104 setprotoent_r 105 setservent_r)}; 106} 107 108my %syms; 109 110for my $exe (@EXES) { 111 # warn "#--- $exe\n"; 112 for my $sym (`$NMU $exe 2>/dev/null`) { 113 chomp $sym; 114 $sym =~ s/^\s+//; 115 $sym =~ s/^([0-9A-Fa-f]+\s+)?[Uu]\s+//; 116 $sym =~ s/\s+[Uu]\s+-$//; 117 next if $sym =~ /\s/; 118 $sym =~ s/\@.*\z//; # remove @@GLIBC_2.0 etc 119 # warn "#### $sym\n"; 120 if (exists $rfuncs{"${sym}_r"} && ! $syms{"$sym:$exe"}++) { 121 push @syms, $sym; 122 } 123 } 124 125 if (@syms) { 126 print "\nFollowing symbols in $exe have reentrant versions:\n"; 127 for my $sym (@syms) { 128 my @f = sort keys %{$rfuncs{$sym . '_r'}}; 129 print "$sym => $sym" . "_r (@f)\n"; 130 } 131 } 132 @syms = (); 133} 134