xref: /petsc/lib/petsc/bin/maint/abi-compliance-checker/modules/Internals/ElfTools.pm (revision e8b6250908b962c387f7ab2e7b38caaa661b5fa1) ! 
1###########################################################################
2# A module to read ELF binaries
3#
4# Copyright (C) 2015-2018 Andrey Ponomarenko's ABI Laboratory
5#
6# Written by Andrey Ponomarenko
7#
8# This library is free software; you can redistribute it and/or
9# modify it under the terms of the GNU Lesser General Public
10# License as published by the Free Software Foundation; either
11# version 2.1 of the License, or (at your option) any later version.
12#
13# This library is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16# Lesser General Public License for more details.
17#
18# You should have received a copy of the GNU Lesser General Public
19# License along with this library; if not, write to the Free Software
20# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
21# MA  02110-1301 USA
22###########################################################################
23use strict;
24
25my %Cache;
26
27my %ELF_BIND = map {$_=>1} (
28    "WEAK",
29    "GLOBAL"
30);
31
32my %ELF_TYPE = map {$_=>1} (
33    "FUNC",
34    "IFUNC",
35    "OBJECT",
36    "COMMON"
37);
38
39my %ELF_VIS = map {$_=>1} (
40    "DEFAULT",
41    "PROTECTED"
42);
43
44sub readline_ELF($)
45{ # read the line of 'readelf' output corresponding to the symbol
46    my @Info = split(/\s+/, $_[0]);
47    #  Num:   Value      Size Type   Bind   Vis       Ndx  Name
48    #  3629:  000b09c0   32   FUNC   GLOBAL DEFAULT   13   _ZNSt12__basic_fileIcED1Ev@@GLIBCXX_3.4
49    #  135:   00000000    0   FUNC   GLOBAL DEFAULT   UND  av_image_fill_pointers@LIBAVUTIL_52 (3)
50    shift(@Info); # spaces
51    shift(@Info); # num
52
53    if($#Info==7)
54    { # UND SYMBOL (N)
55        if($Info[7]=~/\(\d+\)/) {
56            pop(@Info);
57        }
58    }
59
60    if($#Info!=6)
61    { # other lines
62        return ();
63    }
64    return () if(not defined $ELF_TYPE{$Info[2]} and $Info[5] ne "UND");
65    return () if(not defined $ELF_BIND{$Info[3]});
66    return () if(not defined $ELF_VIS{$Info[4]});
67    if($Info[5] eq "ABS" and $Info[0]=~/\A0+\Z/)
68    { # 1272: 00000000     0 OBJECT  GLOBAL DEFAULT  ABS CXXABI_1.3
69        return ();
70    }
71    if($In::Opt{"Target"} eq "symbian")
72    { # _ZN12CCTTokenType4NewLE4TUid3RFs@@ctfinder{000a0000}[102020e5].dll
73        if(index($Info[6], "_._.absent_export_")!=-1)
74        { # "_._.absent_export_111"@@libstdcpp{00010001}[10282872].dll
75            return ();
76        }
77        $Info[6]=~s/\@.+//g; # remove version
78    }
79    if(index($Info[2], "0x") == 0)
80    { # size == 0x3d158
81        $Info[2] = hex($Info[2]);
82    }
83    return @Info;
84}
85
86sub getSONAME($)
87{
88    my $Path = $_[0];
89
90    if(defined $Cache{"getSONAME"}{$Path}) {
91        return $Cache{"getSONAME"}{$Path};
92    }
93    my $Objdump = getCmdPath("objdump");
94    if(not $Objdump) {
95        exitStatus("Not_Found", "can't find \"objdump\"");
96    }
97    my $TmpDir = $In::Opt{"Tmp"};
98    my $SonameCmd = "$Objdump -x \"$Path\" 2>$TmpDir/null";
99    if($In::Opt{"OS"} eq "windows") {
100        $SonameCmd .= " | find \"SONAME\"";
101    }
102    else {
103        $SonameCmd .= " | grep SONAME";
104    }
105    if(my $Info = `$SonameCmd`)
106    {
107        if($Info=~/SONAME\s+([^\s]+)/) {
108            return ($Cache{"getSONAME"}{$Path} = $1);
109        }
110    }
111    return ($Cache{"getSONAME"}{$Path}="");
112}
113
114sub getArch_Object($)
115{
116    my $Path = $_[0];
117
118    my %MachineType = (
119        "14C" => "x86",
120        "8664" => "x86_64",
121        "1C0" => "arm",
122        "200" => "ia64"
123    );
124
125    my %ArchName = (
126        "s390:31-bit" => "s390",
127        "s390:64-bit" => "s390x",
128        "powerpc:common" => "ppc32",
129        "powerpc:common64" => "ppc64",
130        "i386:x86-64" => "x86_64",
131        "mips:3000" => "mips",
132        "sparc:v8plus" => "sparcv9"
133    );
134
135    if($In::Opt{"OS"} eq "windows")
136    {
137        my $DumpbinCmd = getCmdPath("dumpbin");
138        if(not $DumpbinCmd) {
139            exitStatus("Not_Found", "can't find \"dumpbin\"");
140        }
141
142        my $Cmd = $DumpbinCmd." /headers \"$Path\"";
143        my $Out = `$Cmd`;
144
145        if($Out=~/(\w+)\smachine/)
146        {
147            if(my $Type = $MachineType{uc($1)})
148            {
149                return $Type;
150            }
151        }
152    }
153    elsif($In::Opt{"OS"} eq "macos")
154    {
155        my $OtoolCmd = getCmdPath("otool");
156        if(not $OtoolCmd) {
157            exitStatus("Not_Found", "can't find \"otool\"");
158        }
159
160        my $Cmd = $OtoolCmd." -hv -arch all \"$Path\"";
161        my $Out = qx/$Cmd/;
162
163        if($Out=~/X86_64/i) {
164            return "x86_64";
165        }
166        elsif($Out=~/X86/i) {
167            return "x86";
168        }
169    }
170    else
171    { # linux, bsd, gnu, solaris, ...
172        my $ObjdumpCmd = getCmdPath("objdump");
173        if(not $ObjdumpCmd) {
174            exitStatus("Not_Found", "can't find \"objdump\"");
175        }
176
177        my $TmpDir = $In::Opt{"Tmp"};
178        my $Cmd = $ObjdumpCmd." -f \"$Path\" 2>$TmpDir/null";
179
180        my $Locale = $In::Opt{"Locale"};
181        if($In::Opt{"OS"} eq "windows") {
182            $Cmd = "set LANG=$Locale & ".$Cmd;
183        }
184        else {
185            $Cmd = "LANG=$Locale ".$Cmd;
186        }
187        my $Out = `$Cmd`;
188
189        if($Out=~/architecture:\s+([\w\-\:]+)/)
190        {
191            my $Arch = $1;
192            if($Arch=~s/\:(.+)//)
193            {
194                my $Suffix = $1;
195
196                if(my $Name = $ArchName{$Arch.":".$Suffix})
197                {
198                    $Arch = $Name;
199                }
200            }
201
202            if($Arch=~/i[3-6]86/) {
203                $Arch = "x86";
204            }
205
206            if($Arch eq "x86-64") {
207                $Arch = "x86_64";
208            }
209
210            if($Arch eq "ia64-elf64") {
211                $Arch = "ia64";
212            }
213
214            return $Arch;
215        }
216    }
217
218    return undef;
219}
220
221sub getArch_GCC($)
222{
223    my $LVer = $_[0];
224
225    if(defined $Cache{"getArch_GCC"}{$LVer}) {
226        return $Cache{"getArch_GCC"}{$LVer};
227    }
228
229    my $GccPath = $In::Opt{"GccPath"};
230
231    if(not $GccPath) {
232        return undef;
233    }
234
235    my $Arch = undef;
236
237    if(my $Target = $In::Opt{"GccTarget"})
238    {
239        if($Target=~/x86_64/) {
240            $Arch = "x86_64";
241        }
242        elsif($Target=~/i[3-6]86/) {
243            $Arch = "x86";
244        }
245        elsif($Target=~/\Aarm/i) {
246            $Arch = "arm";
247        }
248    }
249
250    if(not $Arch)
251    {
252        my $TmpDir = $In::Opt{"Tmp"};
253        my $OrigDir = $In::Opt{"OrigDir"};
254
255        writeFile($TmpDir."/test.c", "int main(){return 0;}\n");
256
257        my $Cmd = $GccPath." test.c -o test";
258        if(my $Opts = getGccOptions($LVer))
259        { # user-defined options
260            $Cmd .= " ".$Opts;
261        }
262
263        chdir($TmpDir);
264        system($Cmd);
265        chdir($OrigDir);
266
267        my $EX = join_P($TmpDir, "test");
268
269        if($In::Opt{"OS"} eq "windows") {
270            $EX = join_P($TmpDir, "test.exe");
271        }
272
273        $Arch = getArch_Object($EX);
274
275        unlink("$TmpDir/test.c");
276        unlink($EX);
277    }
278
279    if(not $Arch) {
280        exitStatus("Error", "can't check ARCH type");
281    }
282
283    return ($Cache{"getArch_GCC"}{$LVer} = $Arch);
284}
285
286return 1;
287