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