scripts/Dpkg/Shlibs/Symbol.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::Symbol - represent an object file symbol
  22
  23 =head1 DESCRIPTION
  24
  25 This module provides a class to handle symbols from an executable or
  26 shared object file.
  27
  28 B<Note>: This is a private module, its API can change at any time.
  29
  30 =cut
  31
  32 package Dpkg::Shlibs::Symbol 0.01;
  33
  34 use strict;
  35 use warnings;
  36
  37 use Storable ();
  38 use List::Util qw(any);
  39
  40 use Dpkg::Gettext;
  41 use Dpkg::ErrorHandling;
  42 use Dpkg::Arch qw(debarch_is_concerned debarch_to_abiattrs);
  43 use Dpkg::Version;
  44 use Dpkg::Shlibs::Cppfilt;
  45
  46 # Supported alias types in the order of matching preference
  47 use constant ALIAS_TYPES => qw(
  48     c++
  49     symver
  50 );
  51
  52 sub new {
  53     my ($this, %args) = @_;
  54     my $class = ref($this) || $this;
  55     my $self = bless {
  56         symbol => undef,
  57         symbol_templ => undef,
  58         minver => undef,
  59         dep_id => 0,
  60         deprecated => 0,
  61         tags => {},
  62         tagorder => [],
  63     }, $class;
  64     $self->{$_} = $args{$_} foreach keys %args;
  65     return $self;
  66 }
  67
  68 # Deep clone
  69 sub clone {
  70     my ($self, %args) = @_;
  71     my $clone = Storable::dclone($self);
  72     $clone->{$_} = $args{$_} foreach keys %args;
  73     return $clone;
  74 }
  75
  76 sub parse_tagspec {
  77     my ($self, $tagspec) = @_;
  78
  79     if ($tagspec =~ /^\s*\((.*?)\)(.*)$/ && $1) {
  80         # (tag1=t1 value|tag2|...|tagN=tNp)
  81         # Symbols ()|= cannot appear in the tag names and values
  82         $tagspec = $1;
  83         my $rest = ($2) ? $2 : '';
  84         my @tags = split(/\|/, $tagspec);
  85
  86         # Parse each tag
  87         for my $tag (@tags) {
  88             if ($tag =~ /^(.*)=(.*)$/) {
  89                 # Tag with value
  90                 $self->add_tag($1, $2);
  91             } else {
  92                 # Tag without value
  93                 $self->add_tag($tag, undef);
  94             }
  95         }
  96         return $rest;
  97     }
  98     return;
  99 }
 100
 101 sub parse_symbolspec {
 102     my ($self, $symbolspec, %opts) = @_;
 103     my $symbol;
 104     my $symbol_templ;
 105     my $symbol_quoted;
 106     my $rest;
 107
 108     if (defined($symbol = $self->parse_tagspec($symbolspec))) {
 109         # (tag1=t1 value|tag2|...|tagN=tNp)"Foo::Bar::foobar()"@Base 1.0 1
 110         # Symbols ()|= cannot appear in the tag names and values
 111
 112         # If the tag specification exists symbol name template might be quoted too
 113         if ($symbol =~ /^(['"])/ && $symbol =~ /^($1)(.*?)$1(.*)$/) {
 114             $symbol_quoted = $1;
 115             $symbol_templ = $2;
 116             $symbol = $2;
 117             $rest = $3;
 118         } else {
 119             if ($symbol =~ m/^(\S+)(.*)$/) {
 120                 $symbol_templ = $1;
 121                 $symbol = $1;
 122                 $rest = $2;
 123             }
 124         }
 125         error(g_('symbol name unspecified: %s'), $symbolspec) if (!$symbol);
 126     } else {
 127         # No tag specification. Symbol name is up to the first space
 128         # foobarsymbol@Base 1.0 1
 129         if ($symbolspec =~ m/^(\S+)(.*)$/) {
 130             $symbol = $1;
 131             $rest = $2;
 132         } else {
 133             return 0;
 134         }
 135     }
 136     $self->{symbol} = $symbol;
 137     $self->{symbol_templ} = $symbol_templ;
 138     $self->{symbol_quoted} = $symbol_quoted if ($symbol_quoted);
 139
 140     # Now parse "the rest" (minver and dep_id)
 141     if ($rest =~ /^\s(\S+)(?:\s(\d+))?/) {
 142         $self->{minver} = $1;
 143         $self->{dep_id} = $2 // 0;
 144     } elsif (defined $opts{default_minver}) {
 145         $self->{minver} = $opts{default_minver};
 146         $self->{dep_id} = 0;
 147     } else {
 148         return 0;
 149     }
 150     return 1;
 151 }
 152
 153 # A hook for symbol initialization (typically processing of tags). The code
 154 # here may even change symbol name. Called from
 155 # Dpkg::Shlibs::SymbolFile::create_symbol().
 156 sub initialize {
 157     my $self = shift;
 158
 159     # Look for tags marking symbol patterns. The pattern may match multiple
 160     # real symbols.
 161     my $type;
 162     if ($self->has_tag('c++')) {
 163         # Raw symbol name is always demangled to the same alias while demangled
 164         # symbol name cannot be reliably converted back to raw symbol name.
 165         # Therefore, we can use hash for mapping.
 166         $type = 'alias-c++';
 167     }
 168
 169     # Support old style wildcard syntax. That's basically a symver
 170     # with an optional tag.
 171     if ($self->get_symbolname() =~ /^\*@(.*)$/) {
 172         $self->add_tag('symver') unless $self->has_tag('symver');
 173         $self->add_tag('optional') unless $self->has_tag('optional');
 174         $self->{symbol} = $1;
 175     }
 176
 177     if ($self->has_tag('symver')) {
 178         # Each symbol is matched against its version rather than full
 179         # name@version string.
 180         $type = (defined $type) ? 'generic' : 'alias-symver';
 181         if ($self->get_symbolname() =~ /@/) {
 182             warning(g_('symver tag with versioned symbol will not match: %s'),
 183                     $self->get_symbolspec(1));
 184         }
 185         if ($self->get_symbolname() eq 'Base') {
 186             error(g_("you can't use symver tag to catch unversioned symbols: %s"),
 187                   $self->get_symbolspec(1));
 188         }
 189     }
 190
 191     # As soon as regex is involved, we need to match each real
 192     # symbol against each pattern (aka 'generic' pattern).
 193     if ($self->has_tag('regex')) {
 194         $type = 'generic';
 195         # Pre-compile regular expression for better performance.
 196         my $regex = $self->get_symbolname();
 197         $self->{pattern}{regex} = qr/$regex/;
 198     }
 199     if (defined $type) {
 200         $self->init_pattern($type);
 201     }
 202 }
 203
 204 sub get_symbolname {
 205     my $self = shift;
 206
 207     return $self->{symbol};
 208 }
 209
 210 sub get_symboltempl {
 211     my $self = shift;
 212
 213     return $self->{symbol_templ} || $self->{symbol};
 214 }
 215
 216 sub set_symbolname {
 217     my ($self, $name, $templ, $quoted) = @_;
 218
 219     $name //= $self->{symbol};
 220     if (!defined $templ && $name =~ /\s/) {
 221         $templ = $name;
 222     }
 223     if (!defined $quoted && defined $templ && $templ =~ /\s/) {
 224         $quoted = '"';
 225     }
 226     $self->{symbol} = $name;
 227     $self->{symbol_templ} = $templ;
 228     if ($quoted) {
 229         $self->{symbol_quoted} = $quoted;
 230     } else {
 231         delete $self->{symbol_quoted};
 232     }
 233 }
 234
 235 sub has_tags {
 236     my $self = shift;
 237     return scalar (@{$self->{tagorder}});
 238 }
 239
 240 sub add_tag {
 241     my ($self, $tagname, $tagval) = @_;
 242     if (exists $self->{tags}{$tagname}) {
 243         $self->{tags}{$tagname} = $tagval;
 244         return 0;
 245     } else {
 246         $self->{tags}{$tagname} = $tagval;
 247         push @{$self->{tagorder}}, $tagname;
 248     }
 249     return 1;
 250 }
 251
 252 sub delete_tag {
 253     my ($self, $tagname) = @_;
 254     if (exists $self->{tags}{$tagname}) {
 255         delete $self->{tags}{$tagname};
 256         $self->{tagorder} = [ grep { $_ ne $tagname } @{$self->{tagorder}} ];
 257         return 1;
 258     }
 259     return 0;
 260 }
 261
 262 sub has_tag {
 263     my ($self, $tag) = @_;
 264     return exists $self->{tags}{$tag};
 265 }
 266
 267 sub get_tag_value {
 268     my ($self, $tag) = @_;
 269     return $self->{tags}{$tag};
 270 }
 271
 272 # Checks if the symbol is equal to another one (by name and optionally,
 273 # tag sets, versioning info (minver and depid))
 274 sub equals {
 275     my ($self, $other, %opts) = @_;
 276     $opts{versioning} //= 1;
 277     $opts{tags} //= 1;
 278
 279     return 0 if $self->{symbol} ne $other->{symbol};
 280
 281     if ($opts{versioning}) {
 282         return 0 if $self->{minver} ne $other->{minver};
 283         return 0 if $self->{dep_id} ne $other->{dep_id};
 284     }
 285
 286     if ($opts{tags}) {
 287         return 0 if scalar(@{$self->{tagorder}}) != scalar(@{$other->{tagorder}});
 288
 289         for my $i (0 .. scalar(@{$self->{tagorder}}) - 1) {
 290             my $tag = $self->{tagorder}->[$i];
 291             return 0 if $tag ne $other->{tagorder}->[$i];
 292             if (defined $self->{tags}{$tag} && defined $other->{tags}{$tag}) {
 293                 return 0 if $self->{tags}{$tag} ne $other->{tags}{$tag};
 294             } elsif (defined $self->{tags}{$tag} || defined $other->{tags}{$tag}) {
 295                 return 0;
 296             }
 297         }
 298     }
 299
 300     return 1;
 301 }
 302
 303
 304 sub is_optional {
 305     my $self = shift;
 306     return $self->has_tag('optional');
 307 }
 308
 309 sub is_arch_specific {
 310     my $self = shift;
 311     return $self->has_tag('arch');
 312 }
 313
 314 sub arch_is_concerned {
 315     my ($self, $arch) = @_;
 316     my $arches = $self->{tags}{arch};
 317
 318     return 0 if defined $arch && defined $arches &&
 319                 !debarch_is_concerned($arch, split /[\s,]+/, $arches);
 320
 321     my ($bits, $endian) = debarch_to_abiattrs($arch);
 322     return 0 if defined $bits && defined $self->{tags}{'arch-bits'} &&
 323                 $bits ne $self->{tags}{'arch-bits'};
 324     return 0 if defined $endian && defined $self->{tags}{'arch-endian'} &&
 325                 $endian ne $self->{tags}{'arch-endian'};
 326
 327     return 1;
 328 }
 329
 330 # Get reference to the pattern the symbol matches (if any)
 331 sub get_pattern {
 332     my $self = shift;
 333
 334     return $self->{matching_pattern};
 335 }
 336
 337 ### NOTE: subroutines below require (or initialize) $self to be a pattern ###
 338
 339 # Initializes this symbol as a pattern of the specified type.
 340 sub init_pattern {
 341     my ($self, $type) = @_;
 342
 343     $self->{pattern}{type} = $type;
 344     # To be filled with references to symbols matching this pattern.
 345     $self->{pattern}{matches} = [];
 346 }
 347
 348 # Is this symbol a pattern or not?
 349 sub is_pattern {
 350     my $self = shift;
 351
 352     return exists $self->{pattern};
 353 }
 354
 355 # Get pattern type if this symbol is a pattern.
 356 sub get_pattern_type {
 357     my $self = shift;
 358
 359     return $self->{pattern}{type} // '';
 360 }
 361
 362 # Get (sub)type of the alias pattern. Returns empty string if current
 363 # pattern is not alias.
 364 sub get_alias_type {
 365     my $self = shift;
 366
 367     return ($self->get_pattern_type() =~ /^alias-(.+)/ && $1) || '';
 368 }
 369
 370 # Get a list of symbols matching this pattern if this symbol is a pattern
 371 sub get_pattern_matches {
 372     my $self = shift;
 373
 374     return @{$self->{pattern}{matches}};
 375 }
 376
 377 # Create a new symbol based on the pattern (i.e. $self)
 378 # and add it to the pattern matches list.
 379 sub create_pattern_match {
 380     my $self = shift;
 381     return unless $self->is_pattern();
 382
 383     # Leave out 'pattern' subfield while deep-cloning
 384     my $pattern_stuff = $self->{pattern};
 385     delete $self->{pattern};
 386     my $newsym = $self->clone(@_);
 387     $self->{pattern} = $pattern_stuff;
 388
 389     # Clean up symbol name related internal fields
 390     $newsym->set_symbolname();
 391
 392     # Set newsym pattern reference, add to pattern matches list
 393     $newsym->{matching_pattern} = $self;
 394     push @{$self->{pattern}{matches}}, $newsym;
 395     return $newsym;
 396 }
 397
 398 ### END of pattern subroutines ###
 399
 400 # Given a raw symbol name the call returns its alias according to the rules of
 401 # the current pattern ($self). Returns undef if the supplied raw name is not
 402 # transformable to alias.
 403 sub convert_to_alias {
 404     my ($self, $rawname, $type) = @_;
 405     $type = $self->get_alias_type() unless $type;
 406
 407     if ($type) {
 408         if ($type eq 'symver') {
 409             # In case of symver, alias is symbol version. Extract it from the
 410             # rawname.
 411             return "$1" if ($rawname =~ /\@([^@]+)$/);
 412         } elsif ($rawname =~ /^_Z/ && $type eq 'c++') {
 413             return cppfilt_demangle_cpp($rawname);
 414         }
 415     }
 416     return;
 417 }
 418
 419 sub get_tagspec {
 420     my $self = shift;
 421     if ($self->has_tags()) {
 422         my @tags;
 423         for my $tagname (@{$self->{tagorder}}) {
 424             my $tagval = $self->{tags}{$tagname};
 425             if (defined $tagval) {
 426                 push @tags, $tagname . '='  . $tagval;
 427             } else {
 428                 push @tags, $tagname;
 429             }
 430         }
 431         return '(' . join('|', @tags) . ')';
 432     }
 433     return '';
 434 }
 435
 436 sub get_symbolspec {
 437     my $self = shift;
 438     my $template_mode = shift;
 439     my $spec = '';
 440     $spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated};
 441     $spec .= ' ';
 442     if ($template_mode) {
 443         if ($self->has_tags()) {
 444             $spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(),
 445                 $self->get_symboltempl(), $self->{symbol_quoted} // '');
 446         } else {
 447             $spec .= $self->get_symboltempl();
 448         }
 449     } else {
 450         $spec .= $self->get_symbolname();
 451     }
 452     $spec .= " $self->{minver}";
 453     $spec .= " $self->{dep_id}" if $self->{dep_id};
 454     return $spec;
 455 }
 456
 457 # Sanitize the symbol when it is confirmed to be found in
 458 # the respective library.
 459 sub mark_found_in_library {
 460     my ($self, $minver, $arch) = @_;
 461
 462     if ($self->{deprecated}) {
 463         # Symbol reappeared somehow
 464         $self->{deprecated} = 0;
 465         $self->{minver} = $minver if (not $self->is_optional());
 466     } else {
 467         # We assume that the right dependency information is already
 468         # there.
 469         if (version_compare($minver, $self->{minver}) < 0) {
 470             $self->{minver} = $minver;
 471         }
 472     }
 473     # Never remove arch tags from patterns
 474     if (not $self->is_pattern()) {
 475         if (not $self->arch_is_concerned($arch)) {
 476             # Remove arch tags because they are incorrect.
 477             $self->delete_tag('arch');
 478             $self->delete_tag('arch-bits');
 479             $self->delete_tag('arch-endian');
 480         }
 481     }
 482 }
 483
 484 # Sanitize the symbol when it is confirmed to be NOT found in
 485 # the respective library.
 486 # Mark as deprecated those that are no more provided (only if the
 487 # minver is later than the version where the symbol was introduced)
 488 sub mark_not_found_in_library {
 489     my ($self, $minver, $arch) = @_;
 490
 491     # Ignore symbols from foreign arch
 492     return if not $self->arch_is_concerned($arch);
 493
 494     if ($self->{deprecated}) {
 495         # Bump deprecated if the symbol is optional so that it
 496         # keeps reappearing in the diff while it's missing
 497         $self->{deprecated} = $minver if $self->is_optional();
 498     } elsif (version_compare($minver, $self->{minver}) > 0) {
 499         $self->{deprecated} = $minver;
 500     }
 501 }
 502
 503 # Checks if the symbol (or pattern) is legitimate as a real symbol for the
 504 # specified architecture.
 505 sub is_legitimate {
 506     my ($self, $arch) = @_;
 507     return ! $self->{deprecated} &&
 508            $self->arch_is_concerned($arch);
 509 }
 510
 511 # Determine whether a supplied raw symbol name matches against current ($self)
 512 # symbol or pattern.
 513 sub matches_rawname {
 514     my ($self, $rawname) = @_;
 515     my $target = $rawname;
 516     my $ok = 1;
 517     my $do_eq_match = 1;
 518
 519     if ($self->is_pattern()) {
 520         # Process pattern tags in the order they were specified.
 521         for my $tag (@{$self->{tagorder}}) {
 522             if (any { $tag eq $_ } ALIAS_TYPES) {
 523                 $ok = not not ($target = $self->convert_to_alias($target, $tag));
 524             } elsif ($tag eq 'regex') {
 525                 # Symbol name is a regex. Match it against the target
 526                 $do_eq_match = 0;
 527                 $ok = ($target =~ $self->{pattern}{regex});
 528             }
 529             last if not $ok;
 530         }
 531     }
 532
 533     # Equality match by default
 534     if ($ok && $do_eq_match) {
 535         $ok = $target eq $self->get_symbolname();
 536     }
 537     return $ok;
 538 }
 539
 540 =head1 CHANGES
 541
 542 =head2 Version 0.xx
 543
 544 This is a private module.
 545
 546 =cut
 547
 548 1;