File: findrfuncs

package info (click to toggle)
perl 5.24.1-3+deb9u5
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 103,716 kB
  • sloc: perl: 559,611; ansic: 293,886; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (133 lines) | stat: -rwxr-xr-x 3,144 bytes parent folder | download | duplicates (12)
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 = ();
}