| Current File : //proc/self/root/usr/share/perl5/Dpkg/Shlibs/Symbol.pm |
# 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, %args) = @_;
my $class = ref($this) || $this;
my $self = bless {
symbol => undef,
symbol_templ => undef,
minver => undef,
dep_id => 0,
deprecated => 0,
tags => {},
tagorder => [],
}, $class;
$self->{$_} = $args{$_} foreach keys %args;
return $self;
}
# Deep clone
sub clone {
my ($self, %args) = @_;
my $clone = Storable::dclone($self);
$clone->{$_} = $args{$_} foreach keys %args;
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+)(.*)$/) {
# No tag specification. Symbol name is up to the first space
# foobarsymbol@Base 1.0 1
$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++')) {
# 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 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 to be NOT found in
# the respective library.
# Mark as deprecated those that are no more 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 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;