File Coverage

File:Dpkg/Shlibs/Objdump.pm
Coverage:58.2%

linestmtbrancondsubpodtimecode
1# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
2# Copyright © 2007-2009,2012-2015,2017-2018 Guillem Jover <guillem@debian.org>
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2 of the License, or
7# (at your option) any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program.  If not, see <https://www.gnu.org/licenses/>.
16
17package Dpkg::Shlibs::Objdump;
18
19
2
2
2
2
30
2
24
use strict;
20
2
2
2
2
4
0
36
use warnings;
21
2
2
2
2
2
2
72
use feature qw(state);
22
23our $VERSION = '0.01';
24
25
2
2
2
2
4
2
38
use Dpkg::Gettext;
26
2
2
2
2
4
2
438
use Dpkg::ErrorHandling;
27
28sub new {
29
0
0
0
0
    my $this = shift;
30
0
0
0
    my $class = ref($this) || $this;
31
0
0
    my $self = { objects => {} };
32
0
0
    bless $self, $class;
33
0
0
    return $self;
34}
35
36sub add_object {
37
0
0
0
0
    my ($self, $obj) = @_;
38
0
0
    my $id = $obj->get_id;
39
0
0
0
    if ($id) {
40
0
0
        $self->{objects}{$id} = $obj;
41    }
42
0
0
    return $id;
43}
44
45sub analyze {
46
0
0
0
0
    my ($self, $file) = @_;
47
0
0
    my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
48
49
0
0
    return $self->add_object($obj);
50}
51
52sub locate_symbol {
53
0
0
0
0
    my ($self, $name) = @_;
54
0
0
0
0
    foreach my $obj (values %{$self->{objects}}) {
55
0
0
        my $sym = $obj->get_symbol($name);
56
0
0
0
0
        if (defined($sym) && $sym->{defined}) {
57
0
0
            return $sym;
58        }
59    }
60
0
0
    return;
61}
62
63sub get_object {
64
0
0
0
0
    my ($self, $objid) = @_;
65
0
0
0
    if ($self->has_object($objid)) {
66
0
0
        return $self->{objects}{$objid};
67    }
68
0
0
    return;
69}
70
71sub has_object {
72
0
0
0
0
    my ($self, $objid) = @_;
73
0
0
    return exists $self->{objects}{$objid};
74}
75
76use constant {
77    # ELF Class.
78
2
770
    ELF_BITS_NONE           => 0,
79    ELF_BITS_32             => 1,
80    ELF_BITS_64             => 2,
81
82    # ELF Data encoding.
83    ELF_ORDER_NONE          => 0,
84    ELF_ORDER_2LSB          => 1,
85    ELF_ORDER_2MSB          => 2,
86
87    # ELF Machine.
88    EM_SPARC                => 2,
89    EM_MIPS                 => 8,
90    EM_SPARC64_OLD          => 11,
91    EM_SPARC32PLUS          => 18,
92    EM_PPC64                => 21,
93    EM_S390                 => 22,
94    EM_ARM                  => 40,
95    EM_ALPHA_OLD            => 41,
96    EM_SH                   => 42,
97    EM_SPARC64              => 43,
98    EM_IA64                 => 50,
99    EM_AVR                  => 83,
100    EM_M32R                 => 88,
101    EM_MN10300              => 89,
102    EM_MN10200              => 90,
103    EM_OR1K                 => 92,
104    EM_XTENSA               => 94,
105    EM_MICROBLAZE           => 189,
106    EM_ARCV2                => 195,
107    EM_LOONGARCH            => 258,
108    EM_AVR_OLD              => 0x1057,
109    EM_OR1K_OLD             => 0x8472,
110    EM_ALPHA                => 0x9026,
111    EM_M32R_CYGNUS          => 0x9041,
112    EM_S390_OLD             => 0xa390,
113    EM_XTENSA_OLD           => 0xabc7,
114    EM_MICROBLAZE_OLD       => 0xbaab,
115    EM_MN10300_CYGNUS       => 0xbeef,
116    EM_MN10200_CYGNUS       => 0xdead,
117
118    # ELF Version.
119    EV_NONE                 => 0,
120    EV_CURRENT              => 1,
121
122    # ELF Flags (might influence the ABI).
123    EF_ARM_ALIGN8           => 0x00000040,
124    EF_ARM_NEW_ABI          => 0x00000080,
125    EF_ARM_OLD_ABI          => 0x00000100,
126    EF_ARM_SOFT_FLOAT       => 0x00000200,
127    EF_ARM_HARD_FLOAT       => 0x00000400,
128    EF_ARM_EABI_MASK        => 0xff000000,
129
130    EF_IA64_ABI64           => 0x00000010,
131
132    EF_LOONGARCH_SOFT_FLOAT     => 0x00000001,
133    EF_LOONGARCH_SINGLE_FLOAT   => 0x00000002,
134    EF_LOONGARCH_DOUBLE_FLOAT   => 0x00000003,
135    EF_LOONGARCH_ABI_MASK       => 0x00000007,
136
137    EF_MIPS_ABI2            => 0x00000020,
138    EF_MIPS_32BIT           => 0x00000100,
139    EF_MIPS_FP64            => 0x00000200,
140    EF_MIPS_NAN2008         => 0x00000400,
141    EF_MIPS_ABI_MASK        => 0x0000f000,
142    EF_MIPS_ARCH_MASK       => 0xf0000000,
143
144    EF_PPC64_ABI64          => 0x00000003,
145
146    EF_SH_MACH_MASK         => 0x0000001f,
147
2
2
2
6
0
};
148
149# These map alternative or old machine IDs to their canonical form.
150my %elf_mach_map = (
151    EM_ALPHA_OLD()          => EM_ALPHA,
152    EM_AVR_OLD()            => EM_AVR,
153    EM_M32R_CYGNUS()        => EM_M32R,
154    EM_MICROBLAZE_OLD()     => EM_MICROBLAZE,
155    EM_MN10200_CYGNUS()     => EM_MN10200,
156    EM_MN10300_CYGNUS()     => EM_MN10300,
157    EM_OR1K_OLD()           => EM_OR1K,
158    EM_S390_OLD()           => EM_S390,
159    EM_SPARC32PLUS()        => EM_SPARC,
160    EM_SPARC64_OLD()        => EM_SPARC64,
161    EM_XTENSA_OLD()         => EM_XTENSA,
162);
163
164# These masks will try to expose processor flags that are ABI incompatible,
165# and as such are part of defining the architecture ABI. If uncertain it is
166# always better to not mask a flag, because that preserves the historical
167# behavior, and we do not drop dependencies.
168my %elf_flags_mask = (
169    EM_IA64()               => EF_IA64_ABI64,
170    EM_LOONGARCH()          => EF_LOONGARCH_ABI_MASK,
171    EM_MIPS()               => EF_MIPS_ABI_MASK | EF_MIPS_ABI2,
172    EM_PPC64()              => EF_PPC64_ABI64,
173);
174
175sub get_format {
176
0
0
0
0
    my ($file) = @_;
177
0
0
    state %format;
178
179
0
0
0
    return $format{$file} if exists $format{$file};
180
181
0
0
    my $header;
182
183
0
0
0
    open my $fh, '<', $file or syserr(g_('cannot read %s'), $file);
184
0
0
    my $rc = read $fh, $header, 64;
185
0
0
0
0
    if (not defined $rc) {
186
0
0
        syserr(g_('cannot read %s'), $file);
187    } elsif ($rc != 64) {
188
0
0
        return;
189    }
190
0
0
    close $fh;
191
192
0
0
    my %elf;
193
194    # Unpack the identifier field.
195
0
0
    @elf{qw(magic bits endian vertype osabi verabi)} = unpack 'a4C5', $header;
196
197
0
0
0
    return unless $elf{magic} eq "\x7fELF";
198
0
0
0
    return unless $elf{vertype} == EV_CURRENT;
199
200
0
0
    my ($elf_word, $elf_endian);
201
0
0
0
0
    if ($elf{bits} == ELF_BITS_32) {
202
0
0
        $elf_word = 'L';
203    } elsif ($elf{bits} == ELF_BITS_64) {
204
0
0
        $elf_word = 'Q';
205    } else {
206
0
0
        return;
207    }
208
0
0
0
0
    if ($elf{endian} == ELF_ORDER_2LSB) {
209
0
0
        $elf_endian = '<';
210    } elsif ($elf{endian} == ELF_ORDER_2MSB) {
211
0
0
        $elf_endian = '>';
212    } else {
213
0
0
        return;
214    }
215
216    # Unpack the endianness and size dependent fields.
217
0
0
    my $tmpl = "x16(S2Lx[${elf_word}3]L)${elf_endian}";
218
0
0
    @elf{qw(type mach version flags)} = unpack $tmpl, $header;
219
220    # Canonicalize the machine ID.
221
0
0
0
    $elf{mach} = $elf_mach_map{$elf{mach}} // $elf{mach};
222
223    # Mask any processor flags that might not change the architecture ABI.
224
0
0
0
    $elf{flags} &= $elf_flags_mask{$elf{mach}} // 0;
225
226    # Repack for easy comparison, as a big-endian byte stream, so that
227    # unpacking for output gives meaningful results.
228
0
0
    $format{$file} = pack 'C2(SL)>', @elf{qw(bits endian mach flags)};
229
230
0
0
    return $format{$file};
231}
232
233sub is_elf {
234
0
0
0
0
    my $file = shift;
235
0
0
0
    open(my $file_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
236
0
0
    my ($header, $result) = ('', 0);
237
0
0
0
    if (read($file_fh, $header, 4) == 4) {
238
0
0
0
        $result = 1 if ($header =~ /^\177ELF$/);
239    }
240
0
0
    close($file_fh);
241
0
0
    return $result;
242}
243
244package Dpkg::Shlibs::Objdump::Object;
245
246
2
2
2
2
6
2
16
use strict;
247
2
2
2
2
2
2
36
use warnings;
248
2
2
2
2
4
0
24
use feature qw(state);
249
250
2
2
2
2
4
0
44
use Dpkg::Gettext;
251
2
2
2
2
4
0
58
use Dpkg::ErrorHandling;
252
2
2
2
2
1062
2
56
use Dpkg::Path qw(find_command);
253
2
2
2
2
6
2
3214
use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch);
254
255sub new {
256
16
16
23
    my $this = shift;
257
16
50
75
    my $file = shift // '';
258
16
33
50
    my $class = ref($this) || $this;
259
16
18
    my $self = {};
260
16
23
    bless $self, $class;
261
262
16
37
    $self->reset;
263
16
50
22
    if ($file) {
264
0
0
        $self->analyze($file);
265    }
266
267
16
1259
    return $self;
268}
269
270sub reset {
271
24
24
26
    my $self = shift;
272
273
24
36
    $self->{file} = '';
274
24
34
    $self->{id} = '';
275
24
40
    $self->{HASH} = '';
276
24
37
    $self->{GNU_HASH} = '';
277
24
33
    $self->{INTERP} = 0;
278
24
29
    $self->{SONAME} = '';
279
24
38
    $self->{NEEDED} = [];
280
24
35
    $self->{RPATH} = [];
281
24
4387
    $self->{dynsyms} = {};
282
24
32
    $self->{flags} = {};
283
24
45
    $self->{dynrelocs} = {};
284
285
24
25
    return $self;
286}
287
288sub _select_objdump {
289    # Decide which objdump to call
290
0
0
0
0
    if (get_build_arch() ne get_host_arch()) {
291
0
0
        my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump';
292
0
0
0
        return $od if find_command($od);
293    }
294
0
0
    return 'objdump';
295}
296
297sub analyze {
298
0
0
0
    my ($self, $file) = @_;
299
300
0
0
0
    $file ||= $self->{file};
301
0
0
0
    return unless $file;
302
303
0
0
    $self->reset;
304
0
0
    $self->{file} = $file;
305
306
0
0
    $self->{exec_abi} = Dpkg::Shlibs::Objdump::get_format($file);
307
308
0
0
0
    if (not defined $self->{exec_abi}) {
309
0
0
        warning(g_("unknown executable format in file '%s'"), $file);
310
0
0
        return;
311    }
312
313
0
0
    state $OBJDUMP = _select_objdump();
314
0
0
    local $ENV{LC_ALL} = 'C';
315
0
0
0
    open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file)
316        or syserr(g_('cannot fork for %s'), $OBJDUMP);
317
0
0
    my $ret = $self->parse_objdump_output($objdump);
318
0
0
    close($objdump);
319
0
0
    return $ret;
320}
321
322sub parse_objdump_output {
323
24
24
35
    my ($self, $fh) = @_;
324
325
24
30
    my $section = 'none';
326
24
1613
    while (<$fh>) {
327
13136
45202
        s/\s*$//;
328
13136
100
9451
        next if length == 0;
329
330
12952
100
100
100
100
100
100
16580
        if (/^DYNAMIC SYMBOL TABLE:/) {
331
24
18
            $section = 'dynsym';
332
24
26
            next;
333        } elsif (/^DYNAMIC RELOCATION RECORDS/) {
334
12
14
            $section = 'dynreloc';
335
12
14
            $_ = <$fh>; # Skip header
336
12
14
            next;
337        } elsif (/^Dynamic Section:/) {
338
22
22
            $section = 'dyninfo';
339
22
34
            next;
340        } elsif (/^Program Header:/) {
341
20
16
            $section = 'program';
342
20
28
            next;
343        } elsif (/^Version definitions:/) {
344
10
9
            $section = 'verdef';
345
10
17
            next;
346        } elsif (/^Version References:/) {
347
20
11
            $section = 'verref';
348
20
28
            next;
349        }
350
351
12844
100
100
100
100
100
8134
        if ($section eq 'dynsym') {
352
10710
6834
            $self->parse_dynamic_symbol($_);
353        } elsif ($section eq 'dynreloc') {
354
1028
50
907
            if (/^\S+\s+(\S+)\s+(.+)$/) {
355
1028
1264
                $self->{dynrelocs}{$2} = $1;
356            } else {
357
0
0
                warning(g_("couldn't parse dynamic relocation record: %s"), $_);
358            }
359        } elsif ($section eq 'dyninfo') {
360
490
100
100
100
100
50
50
853
            if (/^\s*NEEDED\s+(\S+)/) {
361
36
36
21
63
                push @{$self->{NEEDED}}, $1;
362            } elsif (/^\s*SONAME\s+(\S+)/) {
363
18
31
                $self->{SONAME} = $1;
364            } elsif (/^\s*HASH\s+(\S+)/) {
365
8
12
                $self->{HASH} = $1;
366            } elsif (/^\s*GNU_HASH\s+(\S+)/) {
367
18
29
                $self->{GNU_HASH} = $1;
368            } elsif (/^\s*RUNPATH\s+(\S+)/) {
369                # RUNPATH takes precedence over RPATH but is
370                # considered after LD_LIBRARY_PATH while RPATH
371                # is considered before (if RUNPATH is not set).
372
0
0
                my $runpath = $1;
373
0
0
                $self->{RPATH} = [ split /:/, $runpath ];
374            } elsif (/^\s*RPATH\s+(\S+)/) {
375
0
0
                my $rpath = $1;
376
0
0
0
0
0
                unless (scalar(@{$self->{RPATH}})) {
377
0
0
                    $self->{RPATH} = [ split /:/, $rpath ];
378                }
379            }
380        } elsif ($section eq 'program') {
381
288
100
306
            if (/^\s*INTERP\s+/) {
382
6
6
                $self->{INTERP} = 1;
383            }
384        } elsif ($section eq 'none') {
385
72
100
100
172
            if (/^\s*.+:\s*file\s+format\s+(\S+)$/) {
386
24
91
                $self->{format} = $1;
387            } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:$/) {
388                # Parse 2 lines of "-f"
389                # architecture: i386, flags 0x00000112:
390                # EXEC_P, HAS_SYMS, D_PAGED
391                # start address 0x08049b50
392
24
32
                $_ = <$fh>;
393
24
32
                chomp;
394
24
122
                $self->{flags}{$_} = 1 foreach (split(/,\s*/));
395            }
396        }
397    }
398    # Update status of dynamic symbols given the relocations that have
399    # been parsed after the symbols...
400
24
36
    $self->apply_relocations();
401
402
24
30
    return $section ne 'none';
403}
404
405# Output format of objdump -w -T
406#
407# /lib/libc.so.6:     file format elf32-i386
408#
409# DYNAMIC SYMBOL TABLE:
410# 00056ef0 g    DF .text  000000db  GLIBC_2.2   getwchar
411# 00000000 g    DO *ABS*  00000000  GCC_3.0     GCC_3.0
412# 00069960  w   DF .text  0000001e  GLIBC_2.0   bcmp
413# 00000000  w   D  *UND*  00000000              _pthread_cleanup_pop_restore
414# 0000b788 g    DF .text  0000008e  Base        .protected xine_close
415# 0000b788 g    DF .text  0000008e              .hidden IA__g_free
416# |        ||||||| |      |         |           |
417# |        ||||||| |      |         Version str (.visibility) + Symbol name
418# |        ||||||| |      Alignment
419# |        ||||||| Section name (or *UND* for an undefined symbol)
420# |        ||||||F=Function,f=file,O=object
421# |        |||||d=debugging,D=dynamic
422# |        ||||I=Indirect
423# |        |||W=warning
424# |        ||C=constructor
425# |        |w=weak
426# |        g=global,l=local,!=both global/local
427# Size of the symbol
428#
429# GLIBC_2.2 is the version string associated to the symbol
430# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the
431# symbol exist
432
433my $vis_re = qr/(\.protected|\.hidden|\.internal|0x\S+)/;
434my $dynsym_re = qr<
435    ^
436    [0-9a-f]+                   # Symbol size
437    \ (.{7})                    # Flags
438    \s+(\S+)                    # Section name
439    \s+[0-9a-f]+                # Alignment
440    (?:\s+(\S+))?               # Version string
441    (?:\s+$vis_re)?             # Visibility
442    \s+(.+)                     # Symbol name
443>x;
444
445sub parse_dynamic_symbol {
446
10710
10710
6279
    my ($self, $line) = @_;
447
10710
50
0
0
19138
    if ($line =~ $dynsym_re) {
448
449
10710
11504
        my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5);
450
451        # Special case if version is missing but extra visibility
452        # attribute replaces it in the match
453
10710
100
100
19216
        if (defined($ver) and $ver =~ /^$vis_re$/) {
454
22
18
            $vis = $ver;
455
22
18
            $ver = '';
456        }
457
458        # Cleanup visibility field
459
10710
100
6876
        $vis =~ s/^\.// if defined($vis);
460
461
10710
100
100
36532
        my $symbol = {
462                name => $name,
463                version => $ver // '',
464                section => $sect,
465                dynamic => substr($flags, 5, 1) eq 'D',
466                debug => substr($flags, 5, 1) eq 'd',
467                type => substr($flags, 6, 1),
468                weak => substr($flags, 1, 1) eq 'w',
469                local => substr($flags, 0, 1) eq 'l',
470                global => substr($flags, 0, 1) eq 'g',
471                visibility => $vis // '',
472                hidden => '',
473                defined => $sect ne '*UND*'
474            };
475
476        # Handle hidden symbols
477
10710
100
100
15036
        if (defined($ver) and $ver =~ /^\((.*)\)$/) {
478
528
402
            $ver = $1;
479
528
372
            $symbol->{version} = $1;
480
528
288
            $symbol->{hidden} = 1;
481        }
482
483        # Register symbol
484
10710
7155
        $self->add_dynamic_symbol($symbol);
485    } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) {
486        # Same start but no version and no symbol ... just ignore
487    } elsif ($line =~ /^REG_G\d+\s+/) {
488        # Ignore some s390-specific output like
489        # REG_G6           g     R *UND*      0000000000000000              #scratch
490    } else {
491
0
0
        warning(g_("couldn't parse dynamic symbol definition: %s"), $line);
492    }
493}
494
495sub apply_relocations {
496
24
24
16
    my $self = shift;
497
24
24
24
327
    foreach my $sym (values %{$self->{dynsyms}}) {
498        # We want to mark as undefined symbols those which are currently
499        # defined but that depend on a copy relocation
500
10710
100
8027
        next if not $sym->{defined};
501
502
9768
4549
        my @relocs;
503
504        # When objdump qualifies the symbol with a version it will use @ when
505        # the symbol is in an undefined section (which we discarded above, or
506        # @@ otherwise.
507
9768
100
8085
        push @relocs, $sym->{name} . '@@' . $sym->{version} if $sym->{version};
508
509        # Symbols that are not versioned, or versioned but shown with objdump
510        # from binutils < 2.26, do not have a version appended.
511
9768
5115
        push @relocs, $sym->{name};
512
513
9768
5032
        foreach my $reloc (@relocs) {
514
19332
100
13683
            next if not exists $self->{dynrelocs}{$reloc};
515
208
50
179
            next if not $self->{dynrelocs}{$reloc} =~ /^R_.*_COPY$/;
516
517
0
0
            $sym->{defined} = 0;
518
0
0
            last;
519        }
520    }
521}
522
523sub add_dynamic_symbol {
524
10714
10714
6069
    my ($self, $symbol) = @_;
525
10714
6802
    $symbol->{objid} = $symbol->{soname} = $self->get_id();
526
10714
100
7133
    $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME};
527
10714
100
6520
    if ($symbol->{version}) {
528
10174
21598
        $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
529    } else {
530
540
1182
        $self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol;
531    }
532}
533
534sub get_id {
535
10714
10714
5200
    my $self = shift;
536
10714
67
11439
    return $self->{SONAME} || $self->{file};
537}
538
539sub get_symbol {
540
38
38
54
    my ($self, $name) = @_;
541
38
100
88
    if (exists $self->{dynsyms}{$name}) {
542
32
66
        return $self->{dynsyms}{$name};
543    }
544
6
50
12
    if ($name !~ /@/) {
545
6
50
16
        if (exists $self->{dynsyms}{$name . '@Base'}) {
546
6
14
            return $self->{dynsyms}{$name . '@Base'};
547        }
548    }
549
0
0
    return;
550}
551
552sub get_exported_dynamic_symbols {
553
35
35
40
    my $self = shift;
554
22973
100
100
55133
    return grep { $_->{defined} && $_->{dynamic} && !$_->{local} }
555
35
35
41
1094
            values %{$self->{dynsyms}};
556}
557
558sub get_undefined_dynamic_symbols {
559
2
2
2
    my $self = shift;
560
4480
100
3296
    return grep { (!$_->{defined}) && $_->{dynamic} }
561
2
2
2
104
            values %{$self->{dynsyms}};
562}
563
564sub get_needed_libraries {
565
2
2
2
    my $self = shift;
566
2
2
2
4
    return @{$self->{NEEDED}};
567}
568
569sub is_executable {
570
8
8
10
    my $self = shift;
571    return (exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P}) ||
572
8
33
40
           (exists $self->{INTERP} && $self->{INTERP});
573}
574
575sub is_public_library {
576
8
8
6
    my $self = shift;
577    return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC}
578
8
33
60
        && exists $self->{SONAME} && $self->{SONAME};
579}
580
5811;