scripts/Dpkg/Shlibs/SymbolFile.pm

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