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