Server IP : 85.214.239.14 / Your IP : 3.144.227.3 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Dpkg/Shlibs/ |
Upload File : |
# 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/>. package Dpkg::Shlibs::Symbol; use strict; use warnings; our $VERSION = '0.01'; 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 ); # Needed by the deprecated key, which is a correct use. no if $Dpkg::Version::VERSION ge '1.02', warnings => qw(Dpkg::Version::semantic_change::overload::bool); 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 my $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; } else { if ($symbol =~ m/^(\S+)(.*)$/) { $symbol_templ = $1; $symbol = $1; $rest = $2; } } error(g_('symbol name unspecified: %s'), $symbolspec) if (!$symbol); } else { # No tag specification. Symbol name is up to the first space # foobarsymbol@Base 1.0 1 if ($symbolspec =~ m/^(\S+)(.*)$/) { $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()); } else { # We assume that the right dependency information is already # there. if (version_compare($minver, $self->{minver}) < 0) { $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; } 1;