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 |