| 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 |