OLD | NEW |
| (Empty) |
1 # Copyright © 2007 Raphaël Hertzog <hertzog@debian.org> | |
2 # Copyright © 2009-2010 Modestas Vainius <modax@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 package Dpkg::Shlibs::SymbolFile; | |
18 | |
19 use strict; | |
20 use warnings; | |
21 | |
22 our $VERSION = '0.01'; | |
23 | |
24 use Dpkg::Gettext; | |
25 use Dpkg::ErrorHandling; | |
26 use Dpkg::Version; | |
27 use Dpkg::Control::Fields; | |
28 use Dpkg::Shlibs::Symbol; | |
29 use Dpkg::Arch qw(get_host_arch); | |
30 | |
31 use parent qw(Dpkg::Interface::Storable); | |
32 | |
33 my %blacklist = ( | |
34 __bss_end__ => 1, # arm | |
35 __bss_end => 1, # arm | |
36 _bss_end__ => 1, # arm | |
37 __bss_start => 1, # ALL | |
38 __bss_start__ => 1, # arm | |
39 __data_start => 1, # arm | |
40 __do_global_ctors_aux => 1, # ia64 | |
41 __do_global_dtors_aux => 1, # ia64 | |
42 __do_jv_register_classes => 1, # ia64 | |
43 _DYNAMIC => 1, # ALL | |
44 _edata => 1, # ALL | |
45 _end => 1, # ALL | |
46 __end__ => 1, # arm | |
47 __exidx_end => 1, # armel | |
48 __exidx_start => 1, # armel | |
49 _fbss => 1, # mips, mipsel | |
50 _fdata => 1, # mips, mipsel | |
51 _fini => 1, # ALL | |
52 _ftext => 1, # mips, mipsel | |
53 _GLOBAL_OFFSET_TABLE_ => 1, # hppa, mips, mipsel | |
54 __gmon_start__ => 1, # hppa | |
55 __gnu_local_gp => 1, # mips, mipsel | |
56 _gp => 1, # mips, mipsel | |
57 _init => 1, # ALL | |
58 _PROCEDURE_LINKAGE_TABLE_ => 1, # sparc, alpha | |
59 _SDA2_BASE_ => 1, # powerpc | |
60 _SDA_BASE_ => 1, # powerpc | |
61 ); | |
62 | |
63 for my $i (14 .. 31) { | |
64 # Many powerpc specific symbols | |
65 $blacklist{"_restfpr_$i"} = 1; | |
66 $blacklist{"_restfpr_$i\_x"} = 1; | |
67 $blacklist{"_restgpr_$i"} = 1; | |
68 $blacklist{"_restgpr_$i\_x"} = 1; | |
69 $blacklist{"_savefpr_$i"} = 1; | |
70 $blacklist{"_savegpr_$i"} = 1; | |
71 } | |
72 | |
73 # Many armel-specific symbols | |
74 $blacklist{"__aeabi_$_"} = 1 foreach (qw(cdcmpeq cdcmple cdrcmple cfcmpeq | |
75 cfcmple cfrcmple d2f d2iz d2lz d2uiz d2ulz dadd dcmpeq dcmpge dcmpgt | |
76 dcmple dcmplt dcmpun ddiv dmul dneg drsub dsub f2d f2iz f2lz f2uiz f2ulz | |
77 fadd fcmpeq fcmpge fcmpgt fcmple fcmplt fcmpun fdiv fmul fneg frsub fsub | |
78 i2d i2f idiv idivmod l2d l2f lasr lcmp ldivmod llsl llsr lmul ui2d ui2f | |
79 uidiv uidivmod ul2d ul2f ulcmp uldivmod unwind_cpp_pr0 unwind_cpp_pr1 | |
80 unwind_cpp_pr2 uread4 uread8 uwrite4 uwrite8)); | |
81 | |
82 sub new { | |
83 my $this = shift; | |
84 my %opts=@_; | |
85 my $class = ref($this) || $this; | |
86 my $self = \%opts; | |
87 bless $self, $class; | |
88 $self->{arch} //= get_host_arch(); | |
89 $self->clear(); | |
90 if (exists $self->{file}) { | |
91 $self->load($self->{file}) if -e $self->{file}; | |
92 } | |
93 return $self; | |
94 } | |
95 | |
96 sub get_arch { | |
97 my ($self) = @_; | |
98 return $self->{arch}; | |
99 } | |
100 | |
101 sub clear { | |
102 my ($self) = @_; | |
103 $self->{objects} = {}; | |
104 } | |
105 | |
106 sub clear_except { | |
107 my ($self, @ids) = @_; | |
108 my %has; | |
109 $has{$_} = 1 foreach (@ids); | |
110 foreach my $objid (keys %{$self->{objects}}) { | |
111 delete $self->{objects}{$objid} unless exists $has{$objid}; | |
112 } | |
113 } | |
114 | |
115 sub get_sonames { | |
116 my ($self) = @_; | |
117 return keys %{$self->{objects}}; | |
118 } | |
119 | |
120 sub get_symbols { | |
121 my ($self, $soname) = @_; | |
122 if (defined $soname) { | |
123 my $obj = $self->get_object($soname); | |
124 return (defined $obj) ? values %{$obj->{syms}} : (); | |
125 } else { | |
126 my @syms; | |
127 foreach my $soname ($self->get_sonames()) { | |
128 push @syms, $self->get_symbols($soname); | |
129 } | |
130 return @syms; | |
131 } | |
132 } | |
133 | |
134 sub get_patterns { | |
135 my ($self, $soname) = @_; | |
136 my @patterns; | |
137 if (defined $soname) { | |
138 my $obj = $self->get_object($soname); | |
139 foreach my $alias (values %{$obj->{patterns}{aliases}}) { | |
140 push @patterns, values %$alias; | |
141 } | |
142 return (@patterns, @{$obj->{patterns}{generic}}); | |
143 } else { | |
144 foreach my $soname ($self->get_sonames()) { | |
145 push @patterns, $self->get_patterns($soname); | |
146 } | |
147 return @patterns; | |
148 } | |
149 } | |
150 | |
151 # Create a symbol from the supplied string specification. | |
152 sub create_symbol { | |
153 my ($self, $spec, %opts) = @_; | |
154 my $symbol = (exists $opts{base}) ? $opts{base} : | |
155 Dpkg::Shlibs::Symbol->new(); | |
156 | |
157 my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver =>
0) : | |
158 $symbol->parse_symbolspec($spec); | |
159 if ($ret) { | |
160 $symbol->initialize(arch => $self->get_arch()); | |
161 return $symbol; | |
162 } | |
163 return; | |
164 } | |
165 | |
166 sub add_symbol { | |
167 my ($self, $symbol, $soname) = @_; | |
168 my $object = $self->get_object($soname); | |
169 | |
170 if ($symbol->is_pattern()) { | |
171 if (my $alias_type = $symbol->get_alias_type()) { | |
172 unless (exists $object->{patterns}{aliases}{$alias_type}) { | |
173 $object->{patterns}{aliases}{$alias_type} = {}; | |
174 } | |
175 # Alias hash for matching. | |
176 my $aliases = $object->{patterns}{aliases}{$alias_type}; | |
177 $aliases->{$symbol->get_symbolname()} = $symbol; | |
178 } else { | |
179 # Otherwise assume this is a generic sequential pattern. This | |
180 # should be always safe. | |
181 push @{$object->{patterns}{generic}}, $symbol; | |
182 } | |
183 return 'pattern'; | |
184 } else { | |
185 # invalidate the minimum version cache | |
186 $object->{minver_cache} = []; | |
187 $object->{syms}{$symbol->get_symbolname()} = $symbol; | |
188 return 'sym'; | |
189 } | |
190 } | |
191 | |
192 sub _new_symbol { | |
193 my $base = shift || 'Dpkg::Shlibs::Symbol'; | |
194 return (ref $base) ? $base->clone(@_) : $base->new(@_); | |
195 } | |
196 | |
197 # Parameter seen is only used for recursive calls | |
198 sub parse { | |
199 my ($self, $fh, $file, $seen, $obj_ref, $base_symbol) = @_; | |
200 | |
201 if (defined($seen)) { | |
202 return if exists $seen->{$file}; # Avoid include loops | |
203 } else { | |
204 $self->{file} = $file; | |
205 $seen = {}; | |
206 } | |
207 $seen->{$file} = 1; | |
208 | |
209 if (not ref($obj_ref)) { # Init ref to name of current object/lib | |
210 $$obj_ref = undef; | |
211 } | |
212 | |
213 while (defined($_ = <$fh>)) { | |
214 chomp($_); | |
215 | |
216 if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) { | |
217 if (not defined ($$obj_ref)) { | |
218 error(_g('symbol information must be preceded by a header (file
%s, line %s)'), $file, $.); | |
219 } | |
220 # Symbol specification | |
221 my $deprecated = ($1) ? $1 : 0; | |
222 my $sym = _new_symbol($base_symbol, deprecated => $deprecated); | |
223 if ($self->create_symbol($2, base => $sym)) { | |
224 $self->add_symbol($sym, $$obj_ref); | |
225 } else { | |
226 warning(_g('failed to parse line in %s: %s'), $file, $_); | |
227 } | |
228 } elsif (/^(\(.*\))?#include\s+"([^"]+)"/) { | |
229 my $tagspec = $1; | |
230 my $filename = $2; | |
231 my $dir = $file; | |
232 my $new_base_symbol; | |
233 if (defined $tagspec) { | |
234 $new_base_symbol = _new_symbol($base_symbol); | |
235 $new_base_symbol->parse_tagspec($tagspec); | |
236 } | |
237 $dir =~ s{[^/]+$}{}; # Strip filename | |
238 $self->load("$dir$filename", $seen, $obj_ref, $new_base_symbol); | |
239 } elsif (/^#|^$/) { | |
240 # Skip possible comments and empty lines | |
241 } elsif (/^\|\s*(.*)$/) { | |
242 # Alternative dependency template | |
243 push @{$self->{objects}{$$obj_ref}{deps}}, "$1"; | |
244 } elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) { | |
245 # Add meta-fields | |
246 $self->{objects}{$$obj_ref}{fields}{field_capitalize($1)} = $2; | |
247 } elsif (/^(\S+)\s+(.*)$/) { | |
248 # New object and dependency template | |
249 $$obj_ref = $1; | |
250 if (exists $self->{objects}{$$obj_ref}) { | |
251 # Update/override infos only | |
252 $self->{objects}{$$obj_ref}{deps} = [ "$2" ]; | |
253 } else { | |
254 # Create a new object | |
255 $self->create_object($$obj_ref, "$2"); | |
256 } | |
257 } else { | |
258 warning(_g('failed to parse a line in %s: %s'), $file, $_); | |
259 } | |
260 } | |
261 delete $seen->{$file}; | |
262 } | |
263 | |
264 # Beware: we reuse the data structure of the provided symfile so make | |
265 # sure to not modify them after having called this function | |
266 sub merge_object_from_symfile { | |
267 my ($self, $src, $objid) = @_; | |
268 if (not $self->has_object($objid)) { | |
269 $self->{objects}{$objid} = $src->get_object($objid); | |
270 } else { | |
271 warning(_g('tried to merge the same object (%s) twice in a symfile'), $o
bjid); | |
272 } | |
273 } | |
274 | |
275 sub output { | |
276 my ($self, $fh, %opts) = @_; | |
277 $opts{template_mode} = 0 unless exists $opts{template_mode}; | |
278 $opts{with_deprecated} = 1 unless exists $opts{with_deprecated}; | |
279 $opts{with_pattern_matches} = 0 unless exists $opts{with_pattern_matches}; | |
280 my $res = ''; | |
281 foreach my $soname (sort $self->get_sonames()) { | |
282 my @deps = $self->get_dependencies($soname); | |
283 my $dep_first = shift @deps; | |
284 $dep_first =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package}; | |
285 print { $fh } "$soname $dep_first\n" if defined $fh; | |
286 $res .= "$soname $dep_first\n" if defined wantarray; | |
287 | |
288 foreach my $dep_next (@deps) { | |
289 $dep_next =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package}; | |
290 print { $fh } "| $dep_next\n" if defined $fh; | |
291 $res .= "| $dep_next\n" if defined wantarray; | |
292 } | |
293 my $f = $self->{objects}{$soname}{fields}; | |
294 foreach my $field (sort keys %{$f}) { | |
295 my $value = $f->{$field}; | |
296 $value =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package}; | |
297 print { $fh } "* $field: $value\n" if defined $fh; | |
298 $res .= "* $field: $value\n" if defined wantarray; | |
299 } | |
300 | |
301 my @symbols; | |
302 if ($opts{template_mode}) { | |
303 # Exclude symbols matching a pattern, but include patterns themselve
s | |
304 @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname
); | |
305 push @symbols, $self->get_patterns($soname); | |
306 } else { | |
307 @symbols = $self->get_symbols($soname); | |
308 } | |
309 foreach my $sym (sort { $a->get_symboltempl() cmp | |
310 $b->get_symboltempl() } @symbols) { | |
311 next if $sym->{deprecated} and not $opts{with_deprecated}; | |
312 # Do not dump symbols from foreign arch unless dumping a template. | |
313 next if not $opts{template_mode} and | |
314 not $sym->arch_is_concerned($self->get_arch()); | |
315 # Dump symbol specification. Dump symbol tags only in template mode. | |
316 print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if de
fined $fh; | |
317 $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined
wantarray; | |
318 # Dump pattern matches as comments (if requested) | |
319 if ($opts{with_pattern_matches} && $sym->is_pattern()) { | |
320 for my $match (sort { $a->get_symboltempl() cmp | |
321 $b->get_symboltempl() } $sym->get_pattern_
matches()) | |
322 { | |
323 print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if
defined $fh; | |
324 $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defi
ned wantarray; | |
325 } | |
326 } | |
327 } | |
328 } | |
329 return $res; | |
330 } | |
331 | |
332 # Tries to match a symbol name and/or version against the patterns defined. | |
333 # Returns a pattern which matches (if any). | |
334 sub find_matching_pattern { | |
335 my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |
336 $inc_deprecated //= 0; | |
337 my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | |
338 | |
339 my $pattern_ok = sub { | |
340 my $p = shift; | |
341 return defined $p && ($inc_deprecated || !$p->{deprecated}) && | |
342 $p->arch_is_concerned($self->get_arch()); | |
343 }; | |
344 | |
345 foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | |
346 my $obj = $self->get_object($soname); | |
347 my ($type, $pattern); | |
348 next unless defined $obj; | |
349 | |
350 my $all_aliases = $obj->{patterns}{aliases}; | |
351 for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) { | |
352 if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}}))
{ | |
353 my $aliases = $all_aliases->{$type}; | |
354 my $converter = $aliases->{(keys %$aliases)[0]}; | |
355 if (my $alias = $converter->convert_to_alias($name)) { | |
356 if ($alias && exists $aliases->{$alias}) { | |
357 $pattern = $aliases->{$alias}; | |
358 last if &$pattern_ok($pattern); | |
359 $pattern = undef; # otherwise not found yet | |
360 } | |
361 } | |
362 } | |
363 } | |
364 | |
365 # Now try generic patterns and use the first that matches | |
366 if (not defined $pattern) { | |
367 for my $p (@{$obj->{patterns}{generic}}) { | |
368 if (&$pattern_ok($p) && $p->matches_rawname($name)) { | |
369 $pattern = $p; | |
370 last; | |
371 } | |
372 } | |
373 } | |
374 if (defined $pattern) { | |
375 return (wantarray) ? | |
376 ( symbol => $pattern, soname => $soname ) : $pattern; | |
377 } | |
378 } | |
379 return; | |
380 } | |
381 | |
382 # merge_symbols($object, $minver) | |
383 # Needs $Objdump->get_object($soname) as parameter | |
384 # Don't merge blacklisted symbols related to the internal (arch-specific) | |
385 # machinery | |
386 sub merge_symbols { | |
387 my ($self, $object, $minver) = @_; | |
388 | |
389 my $soname = $object->{SONAME}; | |
390 error(_g('cannot merge symbols from objects without SONAME')) | |
391 unless $soname; | |
392 | |
393 my %dynsyms; | |
394 foreach my $sym ($object->get_exported_dynamic_symbols()) { | |
395 my $name = $sym->{name} . '@' . | |
396 ($sym->{version} ? $sym->{version} : 'Base'); | |
397 my $symobj = $self->lookup_symbol($name, $soname); | |
398 if (exists $blacklist{$sym->{name}}) { | |
399 next unless (defined $symobj and $symobj->has_tag('ignore-blacklist'
)); | |
400 } | |
401 $dynsyms{$name} = $sym; | |
402 } | |
403 | |
404 unless ($self->has_object($soname)) { | |
405 $self->create_object($soname, ''); | |
406 } | |
407 # Scan all symbols provided by the objects | |
408 my $obj = $self->get_object($soname); | |
409 # invalidate the minimum version cache - it is not sufficient to | |
410 # invalidate in add_symbol, since we might change a minimum | |
411 # version for a particular symbol without adding it | |
412 $obj->{minver_cache} = []; | |
413 foreach my $name (keys %dynsyms) { | |
414 my $sym; | |
415 if ($sym = $self->lookup_symbol($name, $obj, 1)) { | |
416 # If the symbol is already listed in the file | |
417 $sym->mark_found_in_library($minver, $self->get_arch()); | |
418 } else { | |
419 # The exact symbol is not present in the file, but it might match a | |
420 # pattern. | |
421 my $pattern = $self->find_matching_pattern($name, $obj, 1); | |
422 if (defined $pattern) { | |
423 $pattern->mark_found_in_library($minver, $self->get_arch()); | |
424 $sym = $pattern->create_pattern_match(symbol => $name); | |
425 } else { | |
426 # Symbol without any special info as no pattern matched | |
427 $sym = Dpkg::Shlibs::Symbol->new(symbol => $name, | |
428 minver => $minver); | |
429 } | |
430 $self->add_symbol($sym, $obj); | |
431 } | |
432 } | |
433 | |
434 # Process all symbols which could not be found in the library. | |
435 foreach my $sym ($self->get_symbols($soname)) { | |
436 if (not exists $dynsyms{$sym->get_symbolname()}) { | |
437 $sym->mark_not_found_in_library($minver, $self->get_arch()); | |
438 } | |
439 } | |
440 | |
441 # Deprecate patterns which didn't match anything | |
442 for my $pattern (grep { $_->get_pattern_matches() == 0 } | |
443 $self->get_patterns($soname)) { | |
444 $pattern->mark_not_found_in_library($minver, $self->get_arch()); | |
445 } | |
446 } | |
447 | |
448 sub is_empty { | |
449 my ($self) = @_; | |
450 return scalar(keys %{$self->{objects}}) ? 0 : 1; | |
451 } | |
452 | |
453 sub has_object { | |
454 my ($self, $soname) = @_; | |
455 return exists $self->{objects}{$soname}; | |
456 } | |
457 | |
458 sub get_object { | |
459 my ($self, $soname) = @_; | |
460 return ref($soname) ? $soname : $self->{objects}{$soname}; | |
461 } | |
462 | |
463 sub create_object { | |
464 my ($self, $soname, @deps) = @_; | |
465 $self->{objects}{$soname} = { | |
466 syms => {}, | |
467 fields => {}, | |
468 patterns => { | |
469 aliases => {}, | |
470 generic => [], | |
471 }, | |
472 deps => [ @deps ], | |
473 minver_cache => [] | |
474 }; | |
475 } | |
476 | |
477 sub get_dependency { | |
478 my ($self, $soname, $dep_id) = @_; | |
479 $dep_id //= 0; | |
480 return $self->get_object($soname)->{deps}[$dep_id]; | |
481 } | |
482 | |
483 sub get_smallest_version { | |
484 my ($self, $soname, $dep_id) = @_; | |
485 $dep_id //= 0; | |
486 my $so_object = $self->get_object($soname); | |
487 return $so_object->{minver_cache}[$dep_id] if(defined($so_object->{minver_ca
che}[$dep_id])); | |
488 my $minver; | |
489 foreach my $sym ($self->get_symbols($so_object)) { | |
490 next if $dep_id != $sym->{dep_id}; | |
491 $minver //= $sym->{minver}; | |
492 if (version_compare($minver, $sym->{minver}) > 0) { | |
493 $minver = $sym->{minver}; | |
494 } | |
495 } | |
496 $so_object->{minver_cache}[$dep_id] = $minver; | |
497 return $minver; | |
498 } | |
499 | |
500 sub get_dependencies { | |
501 my ($self, $soname) = @_; | |
502 return @{$self->get_object($soname)->{deps}}; | |
503 } | |
504 | |
505 sub get_field { | |
506 my ($self, $soname, $name) = @_; | |
507 if (my $obj = $self->get_object($soname)) { | |
508 if (exists $obj->{fields}{$name}) { | |
509 return $obj->{fields}{$name}; | |
510 } | |
511 } | |
512 return; | |
513 } | |
514 | |
515 # Tries to find a symbol like the $refsym and returns its descriptor. | |
516 # $refsym may also be a symbol name. | |
517 sub lookup_symbol { | |
518 my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |
519 $inc_deprecated //= 0; | |
520 my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | |
521 | |
522 foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | |
523 if (my $obj = $self->get_object($so)) { | |
524 my $sym = $obj->{syms}{$name}; | |
525 if ($sym and ($inc_deprecated or not $sym->{deprecated})) | |
526 { | |
527 return (wantarray) ? | |
528 ( symbol => $sym, soname => $so ) : $sym; | |
529 } | |
530 } | |
531 } | |
532 return; | |
533 } | |
534 | |
535 # Tries to find a pattern like the $refpat and returns its descriptor. | |
536 # $refpat may also be a pattern spec. | |
537 sub lookup_pattern { | |
538 my ($self, $refpat, $sonames, $inc_deprecated) = @_; | |
539 $inc_deprecated //= 0; | |
540 # If $refsym is a string, we need to create a dummy ref symbol. | |
541 $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat); | |
542 | |
543 if ($refpat && $refpat->is_pattern()) { | |
544 foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | |
545 if (my $obj = $self->get_object($soname)) { | |
546 my $pat; | |
547 if (my $type = $refpat->get_alias_type()) { | |
548 if (exists $obj->{patterns}{aliases}{$type}) { | |
549 $pat = $obj->{patterns}{aliases}{$type}{$refpat->get_sym
bolname()}; | |
550 } | |
551 } elsif ($refpat->get_pattern_type() eq 'generic') { | |
552 for my $p (@{$obj->{patterns}{generic}}) { | |
553 if (($inc_deprecated || !$p->{deprecated}) && | |
554 $p->equals($refpat, versioning => 0)) | |
555 { | |
556 $pat = $p; | |
557 last; | |
558 } | |
559 } | |
560 } | |
561 if ($pat && ($inc_deprecated || !$pat->{deprecated})) { | |
562 return (wantarray) ? | |
563 (symbol => $pat, soname => $soname) : $pat; | |
564 } | |
565 } | |
566 } | |
567 } | |
568 return; | |
569 } | |
570 | |
571 # Get symbol object reference either by symbol name or by a reference object. | |
572 sub get_symbol_object { | |
573 my ($self, $refsym, $soname) = @_; | |
574 my $sym = $self->lookup_symbol($refsym, $soname, 1); | |
575 if (! defined $sym) { | |
576 $sym = $self->lookup_pattern($refsym, $soname, 1); | |
577 } | |
578 return $sym; | |
579 } | |
580 | |
581 sub get_new_symbols { | |
582 my ($self, $ref, %opts) = @_; | |
583 my $with_optional = (exists $opts{with_optional}) ? | |
584 $opts{with_optional} : 0; | |
585 my @res; | |
586 foreach my $soname ($self->get_sonames()) { | |
587 next if not $ref->has_object($soname); | |
588 | |
589 # Scan raw symbols first. | |
590 foreach my $sym (grep { ($with_optional || ! $_->is_optional()) | |
591 && $_->is_legitimate($self->get_arch()) } | |
592 $self->get_symbols($soname)) | |
593 { | |
594 my $refsym = $ref->lookup_symbol($sym, $soname, 1); | |
595 my $isnew; | |
596 if (defined $refsym) { | |
597 # If the symbol exists in the $ref symbol file, it might | |
598 # still be new if $refsym is not legitimate. | |
599 $isnew = not $refsym->is_legitimate($self->get_arch()); | |
600 } else { | |
601 # If the symbol does not exist in the $ref symbol file, it does | |
602 # not mean that it's new. It might still match a pattern in the | |
603 # symbol file. However, due to performance reasons, first check | |
604 # if the pattern that the symbol matches (if any) exists in the | |
605 # ref symbol file as well. | |
606 $isnew = not ( | |
607 ($sym->get_pattern() and $ref->lookup_pattern($sym->get_patt
ern(), $soname, 1)) or | |
608 $ref->find_matching_pattern($sym, $soname, 1) | |
609 ); | |
610 } | |
611 push @res, { symbol => $sym, soname => $soname } if $isnew; | |
612 } | |
613 | |
614 # Now scan patterns | |
615 foreach my $p (grep { ($with_optional || ! $_->is_optional()) | |
616 && $_->is_legitimate($self->get_arch()) } | |
617 $self->get_patterns($soname)) | |
618 { | |
619 my $refpat = $ref->lookup_pattern($p, $soname, 0); | |
620 # If reference pattern was not found or it is not legitimate, | |
621 # considering current one as new. | |
622 if (not defined $refpat or | |
623 not $refpat->is_legitimate($self->get_arch())) | |
624 { | |
625 push @res, { symbol => $p , soname => $soname }; | |
626 } | |
627 } | |
628 } | |
629 return @res; | |
630 } | |
631 | |
632 sub get_lost_symbols { | |
633 my ($self, $ref, %opts) = @_; | |
634 return $ref->get_new_symbols($self, %opts); | |
635 } | |
636 | |
637 | |
638 sub get_new_libs { | |
639 my ($self, $ref) = @_; | |
640 my @res; | |
641 foreach my $soname ($self->get_sonames()) { | |
642 push @res, $soname if not $ref->get_object($soname); | |
643 } | |
644 return @res; | |
645 } | |
646 | |
647 sub get_lost_libs { | |
648 my ($self, $ref) = @_; | |
649 return $ref->get_new_libs($self); | |
650 } | |
651 | |
652 1; | |
OLD | NEW |