File Coverage

File:Dpkg/Shlibs/Objdump/Object.pm
Coverage:74.5%

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
17=encoding utf8
18
19 - 30
=head1 NAME

Dpkg::Shlibs::Objdump::Object - represent an object from objdump output

=head1 DESCRIPTION

This module provides a class to represent an object parsed from
L<objdump(1)> output.

B<Note>: This is a private module, its API can change at any time.

=cut
31
32package Dpkg::Shlibs::Objdump::Object 0.01;
33
34
6
6
6
6
20
6
142
use strict;
35
6
6
6
6
12
2
242
use warnings;
36
6
6
6
6
24
2
264
use feature qw(state);
37
38
6
6
6
6
14
2
220
use Dpkg::Gettext;
39
6
6
6
6
10
6
232
use Dpkg::ErrorHandling;
40
6
6
6
6
5780
6
252
use Dpkg::Path qw(find_command);
41
6
6
6
6
22
10
9734
use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch);
42
43sub new {
44
48
48
0
83
    my $this = shift;
45
48
50
437
    my $file = shift // '';
46
48
33
515
    my $class = ref($this) || $this;
47
48
72
    my $self = {};
48
48
90
    bless $self, $class;
49
50
48
129
    $self->reset;
51
48
50
96
    if ($file) {
52
0
0
        $self->analyze($file);
53    }
54
55
48
7833
    return $self;
56}
57
58sub reset {
59
72
72
0
100
    my $self = shift;
60
61
72
196
    $self->{file} = '';
62
72
161
    $self->{id} = '';
63
72
142
    $self->{HASH} = '';
64
72
203
    $self->{GNU_HASH} = '';
65
72
312
    $self->{INTERP} = 0;
66
72
159
    $self->{SONAME} = '';
67
72
132
    $self->{NEEDED} = [];
68
72
144
    $self->{RPATH} = [];
69
72
31888
    $self->{dynsyms} = {};
70
72
193
    $self->{flags} = {};
71
72
307
    $self->{dynrelocs} = {};
72
73
72
133
    return $self;
74}
75
76sub _select_objdump {
77    # Decide which objdump to call
78
0
0
0
0
    if (get_build_arch() ne get_host_arch()) {
79
0
0
        my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump';
80
0
0
0
        return $od if find_command($od);
81    }
82
0
0
    return 'objdump';
83}
84
85sub analyze {
86
0
0
0
0
    my ($self, $file) = @_;
87
88
0
0
0
    $file ||= $self->{file};
89
0
0
0
    return unless $file;
90
91
0
0
    $self->reset;
92
0
0
    $self->{file} = $file;
93
94
0
0
    $self->{exec_abi} = Dpkg::Shlibs::Objdump::get_format($file);
95
96
0
0
0
    if (not defined $self->{exec_abi}) {
97
0
0
        warning(g_("unknown executable format in file '%s'"), $file);
98
0
0
        return;
99    }
100
101
0
0
    state $OBJDUMP = _select_objdump();
102
0
0
    local $ENV{LC_ALL} = 'C';
103
0
0
0
    open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file)
104        or syserr(g_('cannot fork for %s'), $OBJDUMP);
105
0
0
    my $ret = $self->parse_objdump_output($objdump);
106
0
0
    close($objdump);
107
0
0
    return $ret;
108}
109
110sub parse_objdump_output {
111
72
72
0
155
    my ($self, $fh) = @_;
112
113
72
111
    my $section = 'none';
114
72
13894
    while (<$fh>) {
115
39408
206053
        s/\s*$//;
116
39408
100
40238
        next if length == 0;
117
118
38856
100
100
100
100
100
100
77388
        if (/^DYNAMIC SYMBOL TABLE:/) {
119
72
98
            $section = 'dynsym';
120
72
134
            next;
121        } elsif (/^DYNAMIC RELOCATION RECORDS/) {
122
36
82
            $section = 'dynreloc';
123
36
78
            $_ = <$fh>; # Skip header
124
36
79
            next;
125        } elsif (/^Dynamic Section:/) {
126
66
94
            $section = 'dyninfo';
127
66
206
            next;
128        } elsif (/^Program Header:/) {
129
60
181
            $section = 'program';
130
60
141
            next;
131        } elsif (/^Version definitions:/) {
132
30
66
            $section = 'verdef';
133
30
80
            next;
134        } elsif (/^Version References:/) {
135
60
84
            $section = 'verref';
136
60
157
            next;
137        }
138
139
38532
100
100
100
100
100
35509
        if ($section eq 'dynsym') {
140
32130
30532
            $self->parse_dynamic_symbol($_);
141        } elsif ($section eq 'dynreloc') {
142
3084
50
4475
            if (/^\S+\s+(\S+)\s+(.+)$/) {
143
3084
6922
                $self->{dynrelocs}{$2} = $1;
144            } else {
145
0
0
                warning(g_("couldn't parse dynamic relocation record: %s"), $_);
146            }
147        } elsif ($section eq 'dyninfo') {
148
1470
100
100
100
100
50
50
4220
            if (/^\s*NEEDED\s+(\S+)/) {
149
108
108
112
447
                push @{$self->{NEEDED}}, $1;
150            } elsif (/^\s*SONAME\s+(\S+)/) {
151
54
226
                $self->{SONAME} = $1;
152            } elsif (/^\s*HASH\s+(\S+)/) {
153
24
68
                $self->{HASH} = $1;
154            } elsif (/^\s*GNU_HASH\s+(\S+)/) {
155
54
166
                $self->{GNU_HASH} = $1;
156            } elsif (/^\s*RUNPATH\s+(\S+)/) {
157                # RUNPATH takes precedence over RPATH but is
158                # considered after LD_LIBRARY_PATH while RPATH
159                # is considered before (if RUNPATH is not set).
160
0
0
                my $runpath = $1;
161
0
0
                $self->{RPATH} = [ split /:/, $runpath ];
162            } elsif (/^\s*RPATH\s+(\S+)/) {
163
0
0
                my $rpath = $1;
164
0
0
0
0
0
                unless (scalar(@{$self->{RPATH}})) {
165
0
0
                    $self->{RPATH} = [ split /:/, $rpath ];
166                }
167            }
168        } elsif ($section eq 'program') {
169
864
100
1335
            if (/^\s*INTERP\s+/) {
170
18
38
                $self->{INTERP} = 1;
171            }
172        } elsif ($section eq 'none') {
173
216
100
100
763
            if (/^\s*.+:\s*file\s+format\s+(\S+)$/) {
174
72
360
                $self->{format} = $1;
175            } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:$/) {
176                # Parse 2 lines of "-f"
177                # architecture: i386, flags 0x00000112:
178                # EXEC_P, HAS_SYMS, D_PAGED
179                # start address 0x08049b50
180
72
127
                $_ = <$fh>;
181
72
117
                chomp;
182
72
557
                $self->{flags}{$_} = 1 foreach (split(/,\s*/));
183            }
184        }
185    }
186    # Update status of dynamic symbols given the relocations that have
187    # been parsed after the symbols...
188
72
210
    $self->apply_relocations();
189
190
72
248
    return $section ne 'none';
191}
192
193# Output format of objdump -w -T
194#
195# /lib/libc.so.6:     file format elf32-i386
196#
197# DYNAMIC SYMBOL TABLE:
198# 00056ef0 g    DF .text  000000db  GLIBC_2.2   getwchar
199# 00000000 g    DO *ABS*  00000000  GCC_3.0     GCC_3.0
200# 00069960  w   DF .text  0000001e  GLIBC_2.0   bcmp
201# 00000000  w   D  *UND*  00000000              _pthread_cleanup_pop_restore
202# 0000b788 g    DF .text  0000008e  Base        .protected xine_close
203# 0000b788 g    DF .text  0000008e              .hidden IA__g_free
204# |        ||||||| |      |         |           |
205# |        ||||||| |      |         Version str (.visibility) + Symbol name
206# |        ||||||| |      Alignment
207# |        ||||||| Section name (or *UND* for an undefined symbol)
208# |        ||||||F=Function,f=file,O=object
209# |        |||||d=debugging,D=dynamic
210# |        ||||I=Indirect
211# |        |||W=warning
212# |        ||C=constructor
213# |        |w=weak
214# |        g=global,l=local,!=both global/local
215# Size of the symbol
216#
217# GLIBC_2.2 is the version string associated to the symbol
218# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the
219# symbol exist
220
221my $vis_re = qr/(\.protected|\.hidden|\.internal|0x\S+)/;
222my $dynsym_re = qr<
223    ^
224    [0-9a-f]+                   # Symbol size
225    \ (.{7})                    # Flags
226    \s+(\S+)                    # Section name
227    \s+[0-9a-f]+                # Alignment
228    (?:\s+(\S+))?               # Version string
229    (?:\s+$vis_re)?             # Visibility
230    \s+(.+)                     # Symbol name
231>x;
232
233sub parse_dynamic_symbol {
234
32130
32130
0
26846
    my ($self, $line) = @_;
235
32130
50
0
0
91426
    if ($line =~ $dynsym_re) {
236
32130
53759
        my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5);
237
238        # Special case if version is missing but extra visibility
239        # attribute replaces it in the match
240
32130
100
100
90518
        if (defined($ver) and $ver =~ /^$vis_re$/) {
241
66
80
            $vis = $ver;
242
66
82
            $ver = '';
243        }
244
245        # Cleanup visibility field
246
32130
100
28371
        $vis =~ s/^\.// if defined($vis);
247
248
32130
100
100
174186
        my $symbol = {
249                name => $name,
250                version => $ver // '',
251                section => $sect,
252                dynamic => substr($flags, 5, 1) eq 'D',
253                debug => substr($flags, 5, 1) eq 'd',
254                type => substr($flags, 6, 1),
255                weak => substr($flags, 1, 1) eq 'w',
256                local => substr($flags, 0, 1) eq 'l',
257                global => substr($flags, 0, 1) eq 'g',
258                visibility => $vis // '',
259                hidden => '',
260                defined => $sect ne '*UND*'
261            };
262
263        # Handle hidden symbols
264
32130
100
100
66557
        if (defined($ver) and $ver =~ /^\((.*)\)$/) {
265
1584
2014
            $ver = $1;
266
1584
2044
            $symbol->{version} = $1;
267
1584
2026
            $symbol->{hidden} = 1;
268        }
269
270        # Register symbol
271
32130
29753
        $self->add_dynamic_symbol($symbol);
272    } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) {
273        # Same start but no version and no symbol ... just ignore
274    } elsif ($line =~ /^REG_G\d+\s+/) {
275        # Ignore some s390-specific output like
276        # REG_G6           g     R *UND*      0000000000000000              #scratch
277    } else {
278
0
0
        warning(g_("couldn't parse dynamic symbol definition: %s"), $line);
279    }
280}
281
282sub apply_relocations {
283
72
72
0
90
    my $self = shift;
284
72
72
81
2691
    foreach my $sym (values %{$self->{dynsyms}}) {
285        # We want to mark as undefined symbols those which are currently
286        # defined but that depend on a copy relocation
287
32130
100
41179
        next if not $sym->{defined};
288
289
29304
16301
        my @relocs;
290
291        # When objdump qualifies the symbol with a version it will use @ when
292        # the symbol is in an undefined section (which we discarded above, or
293        # @@ otherwise.
294
29304
100
41987
        push @relocs, $sym->{name} . '@@' . $sym->{version} if $sym->{version};
295
296        # Symbols that are not versioned, or versioned but shown with objdump
297        # from binutils < 2.26, do not have a version appended.
298
29304
21133
        push @relocs, $sym->{name};
299
300
29304
18096
        foreach my $reloc (@relocs) {
301
57996
100
57509
            next if not exists $self->{dynrelocs}{$reloc};
302
624
50
778
            next if not $self->{dynrelocs}{$reloc} =~ /^R_.*_COPY$/;
303
304
0
0
            $sym->{defined} = 0;
305
0
0
            last;
306        }
307    }
308}
309
310sub add_dynamic_symbol {
311
32142
32142
0
24897
    my ($self, $symbol) = @_;
312
32142
27186
    $symbol->{objid} = $symbol->{soname} = $self->get_id();
313
32142
100
32235
    $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME};
314
32142
100
27467
    if ($symbol->{version}) {
315
30522
111541
        $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
316    } else {
317
1620
10592
        $self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol;
318    }
319}
320
321sub get_id {
322
32142
32142
0
20646
    my $self = shift;
323
32142
67
57523
    return $self->{SONAME} || $self->{file};
324}
325
326sub get_symbol {
327
114
114
0
200
    my ($self, $name) = @_;
328
114
100
274
    if (exists $self->{dynsyms}{$name}) {
329
96
248
        return $self->{dynsyms}{$name};
330    }
331
18
50
80
    if ($name !~ /@/) {
332
18
50
98
        if (exists $self->{dynsyms}{$name . '@Base'}) {
333
18
80
            return $self->{dynsyms}{$name . '@Base'};
334        }
335    }
336
0
0
    return;
337}
338
339sub get_exported_dynamic_symbols {
340
105
105
0
168
    my $self = shift;
341    return grep {
342        $_->{defined} && $_->{dynamic} && !$_->{local}
343
105
68919
105
100
100
159
272666
5131
    } values %{$self->{dynsyms}};
344}
345
346sub get_undefined_dynamic_symbols {
347
6
6
0
12
    my $self = shift;
348    return grep {
349        (!$_->{defined}) && $_->{dynamic}
350
6
13440
6
100
6
20836
1030
    } values %{$self->{dynsyms}};
351}
352
353sub get_needed_libraries {
354
6
6
0
12
    my $self = shift;
355
6
6
8
28
    return @{$self->{NEEDED}};
356}
357
358sub is_executable {
359
24
24
0
40
    my $self = shift;
360    return (exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P}) ||
361
24
33
216
           (exists $self->{INTERP} && $self->{INTERP});
362}
363
364sub is_public_library {
365
24
24
0
30
    my $self = shift;
366    return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC}
367
24
33
290
        && exists $self->{SONAME} && $self->{SONAME};
368}
369
370 - 376
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
377
3781;