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