OLD | NEW |
| (Empty) |
1 # Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org> | |
2 # | |
3 # This program is free software; you can redistribute it and/or modify | |
4 # it under the terms of the GNU General Public License as published by | |
5 # the Free Software Foundation; either version 2 of the License, or | |
6 # (at your option) any later version. | |
7 # | |
8 # This program is distributed in the hope that it will be useful, | |
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 # GNU General Public License for more details. | |
12 # | |
13 # You should have received a copy of the GNU General Public License | |
14 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
15 | |
16 package Dpkg::Shlibs::Objdump; | |
17 | |
18 use strict; | |
19 use warnings; | |
20 | |
21 use Dpkg::Gettext; | |
22 use Dpkg::ErrorHandling; | |
23 use Dpkg::Path qw(find_command); | |
24 use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch); | |
25 use Dpkg::IPC; | |
26 | |
27 our $VERSION = '0.01'; | |
28 | |
29 # Decide which objdump to call | |
30 our $OBJDUMP = 'objdump'; | |
31 if (get_build_arch() ne get_host_arch()) { | |
32 my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump'; | |
33 $OBJDUMP = $od if find_command($od); | |
34 } | |
35 | |
36 | |
37 sub new { | |
38 my $this = shift; | |
39 my $class = ref($this) || $this; | |
40 my $self = { objects => {} }; | |
41 bless $self, $class; | |
42 return $self; | |
43 } | |
44 | |
45 sub add_object { | |
46 my ($self, $obj) = @_; | |
47 my $id = $obj->get_id; | |
48 if ($id) { | |
49 $self->{objects}{$id} = $obj; | |
50 } | |
51 return $id; | |
52 } | |
53 | |
54 sub analyze { | |
55 my ($self, $file) = @_; | |
56 my $obj = Dpkg::Shlibs::Objdump::Object->new($file); | |
57 | |
58 return $self->add_object($obj); | |
59 } | |
60 | |
61 sub locate_symbol { | |
62 my ($self, $name) = @_; | |
63 foreach my $obj (values %{$self->{objects}}) { | |
64 my $sym = $obj->get_symbol($name); | |
65 if (defined($sym) && $sym->{defined}) { | |
66 return $sym; | |
67 } | |
68 } | |
69 return; | |
70 } | |
71 | |
72 sub get_object { | |
73 my ($self, $objid) = @_; | |
74 if ($self->has_object($objid)) { | |
75 return $self->{objects}{$objid}; | |
76 } | |
77 return; | |
78 } | |
79 | |
80 sub has_object { | |
81 my ($self, $objid) = @_; | |
82 return exists $self->{objects}{$objid}; | |
83 } | |
84 | |
85 sub is_armhf { | |
86 my ($file) = @_; | |
87 my ($output, %opts, $pid, $res); | |
88 my $hf = 0; | |
89 my $sf = 0; | |
90 $pid = spawn(exec => [ "readelf", "-h", "--", $file ], | |
91 env => { "LC_ALL" => "C" }, | |
92 to_pipe => \$output, %opts); | |
93 while (<$output>) { | |
94 chomp; | |
95 if (/0x5000402/) { | |
96 $hf = 1; | |
97 last; | |
98 } | |
99 if (/0x5000202/) { | |
100 $sf = 1; | |
101 last; | |
102 } | |
103 } | |
104 close($output); | |
105 wait_child($pid, nocheck => 1); | |
106 if ($?) { | |
107 subprocerr("readelf"); | |
108 } | |
109 if(($hf) || ($sf)) { | |
110 return $hf; | |
111 } | |
112 undef $output; | |
113 $pid = spawn(exec => [ "readelf", "-A", "--", $file ], | |
114 env => { "LC_ALL" => "C" }, | |
115 to_pipe => \$output, %opts); | |
116 while (<$output>) { | |
117 chomp; | |
118 if (/Tag_ABI_VFP_args: VFP registers/) { | |
119 $hf = 1; | |
120 last; | |
121 } | |
122 } | |
123 close($output); | |
124 wait_child($pid, nocheck => 1); | |
125 if ($?) { | |
126 subprocerr("readelf"); | |
127 } | |
128 return $hf; | |
129 } | |
130 | |
131 { | |
132 my %format; # Cache of result | |
133 sub get_format { | |
134 my ($file, $objdump) = @_; | |
135 | |
136 $objdump //= $OBJDUMP; | |
137 | |
138 if (exists $format{$file}) { | |
139 return $format{$file}; | |
140 } else { | |
141 my ($output, %opts, $pid, $res); | |
142 if ($objdump ne 'objdump') { | |
143 $opts{error_to_file} = '/dev/null'; | |
144 } | |
145 $pid = spawn(exec => [ $objdump, '-a', '--', $file ], | |
146 env => { LC_ALL => 'C' }, | |
147 to_pipe => \$output, %opts); | |
148 while (<$output>) { | |
149 chomp; | |
150 if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) { | |
151 $format{$file} = $1; | |
152 $res = $format{$file}; | |
153 last; | |
154 } | |
155 } | |
156 close($output); | |
157 wait_child($pid, nocheck => 1); | |
158 if ($?) { | |
159 subprocerr('objdump') if $objdump eq 'objdump'; | |
160 $res = get_format($file, 'objdump'); | |
161 } | |
162 if ($res eq "elf32-littlearm") { | |
163 if (is_armhf($file)) { | |
164 $res = "elf32-littlearm-hfabi"; | |
165 } else { | |
166 $res = "elf32-littlearm-sfabi"; | |
167 } | |
168 $format{$file} = $res; | |
169 } | |
170 return $res; | |
171 } | |
172 } | |
173 } | |
174 | |
175 sub is_elf { | |
176 my ($file) = @_; | |
177 open(my $file_fh, '<', $file) or syserr(_g('cannot read %s'), $file); | |
178 my ($header, $result) = ('', 0); | |
179 if (read($file_fh, $header, 4) == 4) { | |
180 $result = 1 if ($header =~ /^\177ELF$/); | |
181 } | |
182 close($file_fh); | |
183 return $result; | |
184 } | |
185 | |
186 package Dpkg::Shlibs::Objdump::Object; | |
187 | |
188 use Dpkg::Gettext; | |
189 use Dpkg::ErrorHandling; | |
190 | |
191 sub new { | |
192 my $this = shift; | |
193 my $file = shift || ''; | |
194 my $class = ref($this) || $this; | |
195 my $self = {}; | |
196 bless $self, $class; | |
197 | |
198 $self->reset; | |
199 if ($file) { | |
200 $self->analyze($file); | |
201 } | |
202 | |
203 return $self; | |
204 } | |
205 | |
206 sub reset { | |
207 my ($self) = @_; | |
208 | |
209 $self->{file} = ''; | |
210 $self->{id} = ''; | |
211 $self->{SONAME} = ''; | |
212 $self->{HASH} = ''; | |
213 $self->{GNU_HASH} = ''; | |
214 $self->{SONAME} = ''; | |
215 $self->{NEEDED} = []; | |
216 $self->{RPATH} = []; | |
217 $self->{dynsyms} = {}; | |
218 $self->{flags} = {}; | |
219 $self->{dynrelocs} = {}; | |
220 | |
221 return $self; | |
222 } | |
223 | |
224 | |
225 sub analyze { | |
226 my ($self, $file) = @_; | |
227 | |
228 $file ||= $self->{file}; | |
229 return unless $file; | |
230 | |
231 $self->reset; | |
232 $self->{file} = $file; | |
233 | |
234 local $ENV{LC_ALL} = 'C'; | |
235 open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file) | |
236 or syserr(_g('cannot fork for %s'), $OBJDUMP); | |
237 my $ret = $self->parse_objdump_output($objdump); | |
238 close($objdump); | |
239 return $ret; | |
240 } | |
241 | |
242 sub parse_objdump_output { | |
243 my ($self, $fh) = @_; | |
244 | |
245 my $section = 'none'; | |
246 while (defined($_ = <$fh>)) { | |
247 chomp; | |
248 next if /^\s*$/; | |
249 | |
250 if (/^DYNAMIC SYMBOL TABLE:/) { | |
251 $section = 'dynsym'; | |
252 next; | |
253 } elsif (/^DYNAMIC RELOCATION RECORDS/) { | |
254 $section = 'dynreloc'; | |
255 $_ = <$fh>; # Skip header | |
256 next; | |
257 } elsif (/^Dynamic Section:/) { | |
258 $section = 'dyninfo'; | |
259 next; | |
260 } elsif (/^Program Header:/) { | |
261 $section = 'header'; | |
262 next; | |
263 } elsif (/^Version definitions:/) { | |
264 $section = 'verdef'; | |
265 next; | |
266 } elsif (/^Version References:/) { | |
267 $section = 'verref'; | |
268 next; | |
269 } | |
270 | |
271 if ($section eq 'dynsym') { | |
272 $self->parse_dynamic_symbol($_); | |
273 } elsif ($section eq 'dynreloc') { | |
274 if (/^\S+\s+(\S+)\s+(\S+)\s*$/) { | |
275 $self->{dynrelocs}{$2} = $1; | |
276 } else { | |
277 warning(_g("couldn't parse dynamic relocation record: %s"), $_); | |
278 } | |
279 } elsif ($section eq 'dyninfo') { | |
280 if (/^\s*NEEDED\s+(\S+)/) { | |
281 push @{$self->{NEEDED}}, $1; | |
282 } elsif (/^\s*SONAME\s+(\S+)/) { | |
283 $self->{SONAME} = $1; | |
284 } elsif (/^\s*HASH\s+(\S+)/) { | |
285 $self->{HASH} = $1; | |
286 } elsif (/^\s*GNU_HASH\s+(\S+)/) { | |
287 $self->{GNU_HASH} = $1; | |
288 } elsif (/^\s*RUNPATH\s+(\S+)/) { | |
289 # RUNPATH takes precedence over RPATH but is | |
290 # considered after LD_LIBRARY_PATH while RPATH | |
291 # is considered before (if RUNPATH is not set). | |
292 $self->{RPATH} = [ split (/:/, $1) ]; | |
293 } elsif (/^\s*RPATH\s+(\S+)/) { | |
294 unless (scalar(@{$self->{RPATH}})) { | |
295 $self->{RPATH} = [ split (/:/, $1) ]; | |
296 } | |
297 } | |
298 } elsif ($section eq 'none') { | |
299 if (/^\s*.+:\s*file\s+format\s+(\S+)\s*$/) { | |
300 $self->{format} = $1; | |
301 if (($self->{format} eq "elf32-littlearm") && $self->{file}) { | |
302 if (Dpkg::Shlibs::Objdump::is_armhf($self->{file})) { | |
303 $self->{format} = "elf32-littlearm-hfabi"; | |
304 } else { | |
305 $self->{format} = "elf32-littlearm-sfabi"; | |
306 } | |
307 } | |
308 } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:\s*$/) { | |
309 # Parse 2 lines of "-f" | |
310 # architecture: i386, flags 0x00000112: | |
311 # EXEC_P, HAS_SYMS, D_PAGED | |
312 # start address 0x08049b50 | |
313 $_ = <$fh>; | |
314 chomp; | |
315 $self->{flags}{$_} = 1 foreach (split(/,\s*/)); | |
316 } | |
317 } | |
318 } | |
319 # Update status of dynamic symbols given the relocations that have | |
320 # been parsed after the symbols... | |
321 $self->apply_relocations(); | |
322 | |
323 return $section ne 'none'; | |
324 } | |
325 | |
326 # Output format of objdump -w -T | |
327 # | |
328 # /lib/libc.so.6: file format elf32-i386 | |
329 # | |
330 # DYNAMIC SYMBOL TABLE: | |
331 # 00056ef0 g DF .text 000000db GLIBC_2.2 getwchar | |
332 # 00000000 g DO *ABS* 00000000 GCC_3.0 GCC_3.0 | |
333 # 00069960 w DF .text 0000001e GLIBC_2.0 bcmp | |
334 # 00000000 w D *UND* 00000000 _pthread_cleanup_pop_restore | |
335 # 0000b788 g DF .text 0000008e Base .protected xine_close | |
336 # 0000b788 g DF .text 0000008e .hidden IA__g_free | |
337 # | ||||||| | | | | | |
338 # | ||||||| | | Version str (.visibility) + Symbol name | |
339 # | ||||||| | Alignment | |
340 # | ||||||| Section name (or *UND* for an undefined symbol) | |
341 # | ||||||F=Function,f=file,O=object | |
342 # | |||||d=debugging,D=dynamic | |
343 # | ||||I=Indirect | |
344 # | |||W=warning | |
345 # | ||C=constructor | |
346 # | |w=weak | |
347 # | g=global,l=local,!=both global/local | |
348 # Size of the symbol | |
349 # | |
350 # GLIBC_2.2 is the version string associated to the symbol | |
351 # (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the | |
352 # symbol exist | |
353 | |
354 sub parse_dynamic_symbol { | |
355 my ($self, $line) = @_; | |
356 my $vis_re = '(\.protected|\.hidden|\.internal|0x\S+)'; | |
357 if ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+(?:\s+(\S+))?(?:\s+$vis_r
e)?\s+(\S+)/) { | |
358 | |
359 my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5); | |
360 | |
361 # Special case if version is missing but extra visibility | |
362 # attribute replaces it in the match | |
363 if (defined($ver) and $ver =~ /^$vis_re$/) { | |
364 $vis = $ver; | |
365 $ver = ''; | |
366 } | |
367 | |
368 # Cleanup visibility field | |
369 $vis =~ s/^\.// if defined($vis); | |
370 | |
371 my $symbol = { | |
372 name => $name, | |
373 version => defined($ver) ? $ver : '', | |
374 section => $sect, | |
375 dynamic => substr($flags, 5, 1) eq 'D', | |
376 debug => substr($flags, 5, 1) eq 'd', | |
377 type => substr($flags, 6, 1), | |
378 weak => substr($flags, 1, 1) eq 'w', | |
379 local => substr($flags, 0, 1) eq 'l', | |
380 global => substr($flags, 0, 1) eq 'g', | |
381 visibility => defined($vis) ? $vis : '', | |
382 hidden => '', | |
383 defined => $sect ne '*UND*' | |
384 }; | |
385 | |
386 # Handle hidden symbols | |
387 if (defined($ver) and $ver =~ /^\((.*)\)$/) { | |
388 $ver = $1; | |
389 $symbol->{version} = $1; | |
390 $symbol->{hidden} = 1; | |
391 } | |
392 | |
393 # Register symbol | |
394 $self->add_dynamic_symbol($symbol); | |
395 } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) { | |
396 # Same start but no version and no symbol ... just ignore | |
397 } elsif ($line =~ /^REG_G\d+\s+/) { | |
398 # Ignore some s390-specific output like | |
399 # REG_G6 g R *UND* 0000000000000000 #scr
atch | |
400 } else { | |
401 warning(_g("couldn't parse dynamic symbol definition: %s"), $line); | |
402 } | |
403 } | |
404 | |
405 sub apply_relocations { | |
406 my ($self) = @_; | |
407 foreach my $sym (values %{$self->{dynsyms}}) { | |
408 # We want to mark as undefined symbols those which are currently | |
409 # defined but that depend on a copy relocation | |
410 next if not $sym->{defined}; | |
411 next if not exists $self->{dynrelocs}{$sym->{name}}; | |
412 if ($self->{dynrelocs}{$sym->{name}} =~ /^R_.*_COPY$/) { | |
413 $sym->{defined} = 0; | |
414 } | |
415 } | |
416 } | |
417 | |
418 sub add_dynamic_symbol { | |
419 my ($self, $symbol) = @_; | |
420 $symbol->{objid} = $symbol->{soname} = $self->get_id(); | |
421 $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME}; | |
422 if ($symbol->{version}) { | |
423 $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol; | |
424 } else { | |
425 $self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol; | |
426 } | |
427 } | |
428 | |
429 sub get_id { | |
430 my $self = shift; | |
431 return $self->{SONAME} || $self->{file}; | |
432 } | |
433 | |
434 sub get_symbol { | |
435 my ($self, $name) = @_; | |
436 if (exists $self->{dynsyms}{$name}) { | |
437 return $self->{dynsyms}{$name}; | |
438 } | |
439 if ($name !~ /@/) { | |
440 if (exists $self->{dynsyms}{$name . '@Base'}) { | |
441 return $self->{dynsyms}{$name . '@Base'}; | |
442 } | |
443 } | |
444 return; | |
445 } | |
446 | |
447 sub get_exported_dynamic_symbols { | |
448 my ($self) = @_; | |
449 return grep { $_->{defined} && $_->{dynamic} && !$_->{local} } | |
450 values %{$self->{dynsyms}}; | |
451 } | |
452 | |
453 sub get_undefined_dynamic_symbols { | |
454 my ($self) = @_; | |
455 return grep { (!$_->{defined}) && $_->{dynamic} } | |
456 values %{$self->{dynsyms}}; | |
457 } | |
458 | |
459 sub get_needed_libraries { | |
460 my $self = shift; | |
461 return @{$self->{NEEDED}}; | |
462 } | |
463 | |
464 sub is_executable { | |
465 my $self = shift; | |
466 return exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P}; | |
467 } | |
468 | |
469 sub is_public_library { | |
470 my $self = shift; | |
471 return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC} | |
472 && exists $self->{SONAME} && $self->{SONAME}; | |
473 } | |
474 | |
475 1; | |
OLD | NEW |