542 lines
14 KiB
Perl
542 lines
14 KiB
Perl
# Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
|
|
# Copyright © 2009-2010 Modestas Vainius <modax@debian.org>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
=encoding utf8
|
|
|
|
=head1 NAME
|
|
|
|
Dpkg::Shlibs::Symbol - represent an object file symbol
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides a class to handle symbols from an executable or
|
|
shared object file.
|
|
|
|
B<Note>: This is a private module, its API can change at any time.
|
|
|
|
=cut
|
|
|
|
package Dpkg::Shlibs::Symbol 0.01;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Storable ();
|
|
use List::Util qw(any);
|
|
|
|
use Dpkg::Gettext;
|
|
use Dpkg::ErrorHandling;
|
|
use Dpkg::Arch qw(debarch_is_concerned debarch_to_abiattrs);
|
|
use Dpkg::Version;
|
|
use Dpkg::Shlibs::Cppfilt;
|
|
|
|
# Supported alias types in the order of matching preference.
|
|
use constant ALIAS_TYPES => qw(
|
|
c++
|
|
symver
|
|
);
|
|
|
|
sub new {
|
|
my ($this, %opts) = @_;
|
|
my $class = ref($this) || $this;
|
|
my $self = bless {
|
|
symbol => undef,
|
|
symbol_templ => undef,
|
|
minver => undef,
|
|
dep_id => 0,
|
|
deprecated => 0,
|
|
tags => {},
|
|
tagorder => [],
|
|
}, $class;
|
|
$self->{$_} = $opts{$_} foreach keys %opts;
|
|
return $self;
|
|
}
|
|
|
|
# Deep clone
|
|
sub clone {
|
|
my ($self, %opts) = @_;
|
|
my $clone = Storable::dclone($self);
|
|
$clone->{$_} = $opts{$_} foreach keys %opts;
|
|
return $clone;
|
|
}
|
|
|
|
sub parse_tagspec {
|
|
my ($self, $tagspec) = @_;
|
|
|
|
if ($tagspec =~ /^\s*\((.*?)\)(.*)$/ && $1) {
|
|
# (tag1=t1 value|tag2|...|tagN=tNp)
|
|
# Symbols ()|= cannot appear in the tag names and values.
|
|
$tagspec = $1;
|
|
my $rest = ($2) ? $2 : '';
|
|
my @tags = split(/\|/, $tagspec);
|
|
|
|
# Parse each tag.
|
|
for my $tag (@tags) {
|
|
if ($tag =~ /^(.*)=(.*)$/) {
|
|
# Tag with value.
|
|
$self->add_tag($1, $2);
|
|
} else {
|
|
# Tag without value.
|
|
$self->add_tag($tag, undef);
|
|
}
|
|
}
|
|
return $rest;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub parse_symbolspec {
|
|
my ($self, $symbolspec, %opts) = @_;
|
|
my $symbol;
|
|
my $symbol_templ;
|
|
my $symbol_quoted;
|
|
my $rest;
|
|
|
|
if (defined($symbol = $self->parse_tagspec($symbolspec))) {
|
|
# (tag1=t1 value|tag2|...|tagN=tNp)"Foo::Bar::foobar()"@Base 1.0 1
|
|
# Symbols ()|= cannot appear in the tag names and values.
|
|
|
|
# If the tag specification exists, symbol name template might be
|
|
# quoted too.
|
|
if ($symbol =~ /^(['"])/ && $symbol =~ /^($1)(.*?)$1(.*)$/) {
|
|
$symbol_quoted = $1;
|
|
$symbol_templ = $2;
|
|
$symbol = $2;
|
|
$rest = $3;
|
|
} elsif ($symbol =~ m/^(\S+)(.*)$/) {
|
|
$symbol_templ = $1;
|
|
$symbol = $1;
|
|
$rest = $2;
|
|
}
|
|
error(g_('symbol name unspecified: %s'), $symbolspec) if (!$symbol);
|
|
} elsif ($symbolspec =~ m/^(\S+)(.*)$/) {
|
|
# foobarsymbol@Base 1.0 1
|
|
# No tag specification. Symbol name is up to the first space.
|
|
$symbol = $1;
|
|
$rest = $2;
|
|
} else {
|
|
return 0;
|
|
}
|
|
$self->{symbol} = $symbol;
|
|
$self->{symbol_templ} = $symbol_templ;
|
|
$self->{symbol_quoted} = $symbol_quoted if ($symbol_quoted);
|
|
|
|
# Now parse "the rest" (minver and dep_id).
|
|
if ($rest =~ /^\s(\S+)(?:\s(\d+))?/) {
|
|
$self->{minver} = $1;
|
|
$self->{dep_id} = $2 // 0;
|
|
} elsif (defined $opts{default_minver}) {
|
|
$self->{minver} = $opts{default_minver};
|
|
$self->{dep_id} = 0;
|
|
} else {
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
# A hook for symbol initialization (typically processing of tags). The code
|
|
# here may even change symbol name. Called from
|
|
# Dpkg::Shlibs::SymbolFile::create_symbol().
|
|
sub initialize {
|
|
my $self = shift;
|
|
|
|
# Look for tags marking symbol patterns. The pattern may match multiple
|
|
# real symbols.
|
|
my $type;
|
|
if ($self->has_tag('c++')) {
|
|
# The raw symbol name is always demangled to the same alias, while
|
|
# demangled symbol name cannot be reliably converted back to raw
|
|
# symbol name. Therefore, we can use a hash for mapping.
|
|
$type = 'alias-c++';
|
|
}
|
|
|
|
# Support old style wildcard syntax. That's basically a symver with an
|
|
# optional tag.
|
|
if ($self->get_symbolname() =~ /^\*@(.*)$/) {
|
|
$self->add_tag('symver') unless $self->has_tag('symver');
|
|
$self->add_tag('optional') unless $self->has_tag('optional');
|
|
$self->{symbol} = $1;
|
|
}
|
|
|
|
if ($self->has_tag('symver')) {
|
|
# Each symbol is matched against its version rather than full
|
|
# name@version string.
|
|
$type = (defined $type) ? 'generic' : 'alias-symver';
|
|
if ($self->get_symbolname() =~ /@/) {
|
|
warning(g_('symver tag with versioned symbol will not match: %s'),
|
|
$self->get_symbolspec(1));
|
|
}
|
|
if ($self->get_symbolname() eq 'Base') {
|
|
error(g_("you can't use symver tag to catch unversioned symbols: %s"),
|
|
$self->get_symbolspec(1));
|
|
}
|
|
}
|
|
|
|
# As soon as "regex" is involved, we need to match each real symbol
|
|
# against each pattern (aka 'generic' pattern).
|
|
if ($self->has_tag('regex')) {
|
|
$type = 'generic';
|
|
# Pre-compile regular expression for better performance.
|
|
my $regex = $self->get_symbolname();
|
|
$self->{pattern}{regex} = qr/$regex/;
|
|
}
|
|
if (defined $type) {
|
|
$self->init_pattern($type);
|
|
}
|
|
}
|
|
|
|
sub get_symbolname {
|
|
my $self = shift;
|
|
|
|
return $self->{symbol};
|
|
}
|
|
|
|
sub get_symboltempl {
|
|
my $self = shift;
|
|
|
|
return $self->{symbol_templ} || $self->{symbol};
|
|
}
|
|
|
|
sub set_symbolname {
|
|
my ($self, $name, $templ, $quoted) = @_;
|
|
|
|
$name //= $self->{symbol};
|
|
if (!defined $templ && $name =~ /\s/) {
|
|
$templ = $name;
|
|
}
|
|
if (!defined $quoted && defined $templ && $templ =~ /\s/) {
|
|
$quoted = '"';
|
|
}
|
|
$self->{symbol} = $name;
|
|
$self->{symbol_templ} = $templ;
|
|
if ($quoted) {
|
|
$self->{symbol_quoted} = $quoted;
|
|
} else {
|
|
delete $self->{symbol_quoted};
|
|
}
|
|
}
|
|
|
|
sub has_tags {
|
|
my $self = shift;
|
|
return scalar (@{$self->{tagorder}});
|
|
}
|
|
|
|
sub add_tag {
|
|
my ($self, $tagname, $tagval) = @_;
|
|
if (exists $self->{tags}{$tagname}) {
|
|
$self->{tags}{$tagname} = $tagval;
|
|
return 0;
|
|
} else {
|
|
$self->{tags}{$tagname} = $tagval;
|
|
push @{$self->{tagorder}}, $tagname;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub delete_tag {
|
|
my ($self, $tagname) = @_;
|
|
if (exists $self->{tags}{$tagname}) {
|
|
delete $self->{tags}{$tagname};
|
|
$self->{tagorder} = [ grep { $_ ne $tagname } @{$self->{tagorder}} ];
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub has_tag {
|
|
my ($self, $tag) = @_;
|
|
return exists $self->{tags}{$tag};
|
|
}
|
|
|
|
sub get_tag_value {
|
|
my ($self, $tag) = @_;
|
|
return $self->{tags}{$tag};
|
|
}
|
|
|
|
# Checks if the symbol is equal to another one, by name and optionally,
|
|
# tag sets, versioning info (minver and depid).
|
|
sub equals {
|
|
my ($self, $other, %opts) = @_;
|
|
$opts{versioning} //= 1;
|
|
$opts{tags} //= 1;
|
|
|
|
return 0 if $self->{symbol} ne $other->{symbol};
|
|
|
|
if ($opts{versioning}) {
|
|
return 0 if $self->{minver} ne $other->{minver};
|
|
return 0 if $self->{dep_id} ne $other->{dep_id};
|
|
}
|
|
|
|
if ($opts{tags}) {
|
|
return 0 if scalar(@{$self->{tagorder}}) != scalar(@{$other->{tagorder}});
|
|
|
|
for my $i (0 .. scalar(@{$self->{tagorder}}) - 1) {
|
|
my $tag = $self->{tagorder}->[$i];
|
|
return 0 if $tag ne $other->{tagorder}->[$i];
|
|
if (defined $self->{tags}{$tag} && defined $other->{tags}{$tag}) {
|
|
return 0 if $self->{tags}{$tag} ne $other->{tags}{$tag};
|
|
} elsif (defined $self->{tags}{$tag} || defined $other->{tags}{$tag}) {
|
|
return 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
sub is_optional {
|
|
my $self = shift;
|
|
return $self->has_tag('optional');
|
|
}
|
|
|
|
sub is_arch_specific {
|
|
my $self = shift;
|
|
return $self->has_tag('arch');
|
|
}
|
|
|
|
sub arch_is_concerned {
|
|
my ($self, $arch) = @_;
|
|
my $arches = $self->{tags}{arch};
|
|
|
|
return 0 if defined $arch && defined $arches &&
|
|
!debarch_is_concerned($arch, split /[\s,]+/, $arches);
|
|
|
|
my ($bits, $endian) = debarch_to_abiattrs($arch);
|
|
return 0 if defined $bits && defined $self->{tags}{'arch-bits'} &&
|
|
$bits ne $self->{tags}{'arch-bits'};
|
|
return 0 if defined $endian && defined $self->{tags}{'arch-endian'} &&
|
|
$endian ne $self->{tags}{'arch-endian'};
|
|
|
|
return 1;
|
|
}
|
|
|
|
# Get reference to the pattern the symbol matches (if any).
|
|
sub get_pattern {
|
|
my $self = shift;
|
|
|
|
return $self->{matching_pattern};
|
|
}
|
|
|
|
### NOTE: subroutines below require (or initialize) $self to be a pattern ###
|
|
|
|
# Initializes this symbol as a pattern of the specified type.
|
|
sub init_pattern {
|
|
my ($self, $type) = @_;
|
|
|
|
$self->{pattern}{type} = $type;
|
|
# To be filled with references to symbols matching this pattern.
|
|
$self->{pattern}{matches} = [];
|
|
}
|
|
|
|
# Is this symbol a pattern or not?
|
|
sub is_pattern {
|
|
my $self = shift;
|
|
|
|
return exists $self->{pattern};
|
|
}
|
|
|
|
# Get pattern type if this symbol is a pattern.
|
|
sub get_pattern_type {
|
|
my $self = shift;
|
|
|
|
return $self->{pattern}{type} // '';
|
|
}
|
|
|
|
# Get (sub)type of the alias pattern. Returns empty string if current
|
|
# pattern is not alias.
|
|
sub get_alias_type {
|
|
my $self = shift;
|
|
|
|
return ($self->get_pattern_type() =~ /^alias-(.+)/ && $1) || '';
|
|
}
|
|
|
|
# Get a list of symbols matching this pattern if this symbol is a pattern.
|
|
sub get_pattern_matches {
|
|
my $self = shift;
|
|
|
|
return @{$self->{pattern}{matches}};
|
|
}
|
|
|
|
# Create a new symbol based on the pattern (i.e. $self) and add it to the
|
|
# pattern matches list.
|
|
sub create_pattern_match {
|
|
my $self = shift;
|
|
return unless $self->is_pattern();
|
|
|
|
# Leave out 'pattern' subfield while deep-cloning.
|
|
my $pattern_stuff = $self->{pattern};
|
|
delete $self->{pattern};
|
|
my $newsym = $self->clone(@_);
|
|
$self->{pattern} = $pattern_stuff;
|
|
|
|
# Clean up symbol name related internal fields.
|
|
$newsym->set_symbolname();
|
|
|
|
# Set newsym pattern reference, add to pattern matches list.
|
|
$newsym->{matching_pattern} = $self;
|
|
push @{$self->{pattern}{matches}}, $newsym;
|
|
return $newsym;
|
|
}
|
|
|
|
### END of pattern subroutines ###
|
|
|
|
# Given a raw symbol name the call returns its alias according to the rules of
|
|
# the current pattern ($self). Returns undef if the supplied raw name is not
|
|
# transformable to alias.
|
|
sub convert_to_alias {
|
|
my ($self, $rawname, $type) = @_;
|
|
$type = $self->get_alias_type() unless $type;
|
|
|
|
if ($type) {
|
|
if ($type eq 'symver') {
|
|
# In case of symver, alias is symbol version. Extract it from the
|
|
# rawname.
|
|
return "$1" if ($rawname =~ /\@([^@]+)$/);
|
|
} elsif ($rawname =~ /^_Z/ && $type eq 'c++') {
|
|
return cppfilt_demangle_cpp($rawname);
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub get_tagspec {
|
|
my $self = shift;
|
|
if ($self->has_tags()) {
|
|
my @tags;
|
|
for my $tagname (@{$self->{tagorder}}) {
|
|
my $tagval = $self->{tags}{$tagname};
|
|
if (defined $tagval) {
|
|
push @tags, $tagname . '=' . $tagval;
|
|
} else {
|
|
push @tags, $tagname;
|
|
}
|
|
}
|
|
return '(' . join('|', @tags) . ')';
|
|
}
|
|
return '';
|
|
}
|
|
|
|
sub get_symbolspec {
|
|
my $self = shift;
|
|
my $template_mode = shift;
|
|
my $spec = '';
|
|
$spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated};
|
|
$spec .= ' ';
|
|
if ($template_mode) {
|
|
if ($self->has_tags()) {
|
|
$spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(),
|
|
$self->get_symboltempl(), $self->{symbol_quoted} // '');
|
|
} else {
|
|
$spec .= $self->get_symboltempl();
|
|
}
|
|
} else {
|
|
$spec .= $self->get_symbolname();
|
|
}
|
|
$spec .= " $self->{minver}";
|
|
$spec .= " $self->{dep_id}" if $self->{dep_id};
|
|
return $spec;
|
|
}
|
|
|
|
# Sanitize the symbol when it is confirmed to be found in the
|
|
# respective library.
|
|
sub mark_found_in_library {
|
|
my ($self, $minver, $arch) = @_;
|
|
|
|
if ($self->{deprecated}) {
|
|
# Symbol reappeared somehow.
|
|
$self->{deprecated} = 0;
|
|
$self->{minver} = $minver if (not $self->is_optional());
|
|
} elsif (version_compare($minver, $self->{minver}) < 0) {
|
|
# We assume that the right dependency information is already there.
|
|
$self->{minver} = $minver;
|
|
}
|
|
# Never remove arch tags from patterns.
|
|
if (not $self->is_pattern()) {
|
|
if (not $self->arch_is_concerned($arch)) {
|
|
# Remove arch tags because they are incorrect.
|
|
$self->delete_tag('arch');
|
|
$self->delete_tag('arch-bits');
|
|
$self->delete_tag('arch-endian');
|
|
}
|
|
}
|
|
}
|
|
|
|
# Sanitize the symbol when it is confirmed NOT to be found in the
|
|
# respective library.
|
|
# Mark as deprecated those that are no longer provided (only if the
|
|
# minver is later than the version where the symbol was introduced).
|
|
sub mark_not_found_in_library {
|
|
my ($self, $minver, $arch) = @_;
|
|
|
|
# Ignore symbols from a foreign arch.
|
|
return if not $self->arch_is_concerned($arch);
|
|
|
|
if ($self->{deprecated}) {
|
|
# Bump deprecated if the symbol is optional so that it keeps
|
|
# reappearing in the diff while it's missing.
|
|
$self->{deprecated} = $minver if $self->is_optional();
|
|
} elsif (version_compare($minver, $self->{minver}) > 0) {
|
|
$self->{deprecated} = $minver;
|
|
}
|
|
}
|
|
|
|
# Checks if the symbol (or pattern) is legitimate as a real symbol for the
|
|
# specified architecture.
|
|
sub is_legitimate {
|
|
my ($self, $arch) = @_;
|
|
return ! $self->{deprecated} &&
|
|
$self->arch_is_concerned($arch);
|
|
}
|
|
|
|
# Determine whether a supplied raw symbol name matches against current ($self)
|
|
# symbol or pattern.
|
|
sub matches_rawname {
|
|
my ($self, $rawname) = @_;
|
|
my $target = $rawname;
|
|
my $ok = 1;
|
|
my $do_eq_match = 1;
|
|
|
|
if ($self->is_pattern()) {
|
|
# Process pattern tags in the order they were specified.
|
|
for my $tag (@{$self->{tagorder}}) {
|
|
if (any { $tag eq $_ } ALIAS_TYPES) {
|
|
$ok = not not ($target = $self->convert_to_alias($target, $tag));
|
|
} elsif ($tag eq 'regex') {
|
|
# Symbol name is a regex. Match it against the target.
|
|
$do_eq_match = 0;
|
|
$ok = ($target =~ $self->{pattern}{regex});
|
|
}
|
|
last if not $ok;
|
|
}
|
|
}
|
|
|
|
# Equality match by default.
|
|
if ($ok && $do_eq_match) {
|
|
$ok = $target eq $self->get_symbolname();
|
|
}
|
|
return $ok;
|
|
}
|
|
|
|
=head1 CHANGES
|
|
|
|
=head2 Version 0.xx
|
|
|
|
This is a private module.
|
|
|
|
=cut
|
|
|
|
1;
|