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