diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/Dpkg/Shlibs.pm | 184 | ||||
| -rw-r--r-- | scripts/Dpkg/Shlibs/Cppfilt.pm | 120 | ||||
| -rw-r--r-- | scripts/Dpkg/Shlibs/Objdump.pm | 582 | ||||
| -rw-r--r-- | scripts/Dpkg/Shlibs/Symbol.pm | 531 | ||||
| -rw-r--r-- | scripts/Dpkg/Shlibs/SymbolFile.pm | 697 |
5 files changed, 2114 insertions, 0 deletions
diff --git a/scripts/Dpkg/Shlibs.pm b/scripts/Dpkg/Shlibs.pm new file mode 100644 index 0000000..22fecc4 --- /dev/null +++ b/scripts/Dpkg/Shlibs.pm @@ -0,0 +1,184 @@ +# Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2007-2008, 2012-2015 Guillem Jover <guillem@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; + +use strict; +use warnings; +use feature qw(state); + +our $VERSION = '0.03'; +our @EXPORT_OK = qw( + blank_library_paths + setup_library_paths + get_library_paths + add_library_dir + find_library +); + +use Exporter qw(import); +use List::Util qw(none); +use File::Spec; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Shlibs::Objdump; +use Dpkg::Path qw(resolve_symlink canonpath); +use Dpkg::Arch qw(get_build_arch get_host_arch :mappers); + +use constant DEFAULT_LIBRARY_PATH => + qw(/lib /usr/lib); +# XXX: Deprecated multilib paths. +use constant DEFAULT_MULTILIB_PATH => + qw(/lib32 /usr/lib32 /lib64 /usr/lib64); + +# Library paths set by the user. +my @custom_librarypaths; +# Library paths from the system. +my @system_librarypaths; +my $librarypaths_init; + +sub parse_ldso_conf { + my $file = shift; + state %visited; + local $_; + + open my $fh, '<', $file or syserr(g_('cannot open %s'), $file); + $visited{$file}++; + while (<$fh>) { + next if /^\s*$/; + chomp; + s{/+$}{}; + if (/^include\s+(\S.*\S)\s*$/) { + foreach my $include (glob($1)) { + parse_ldso_conf($include) if -e $include + && !$visited{$include}; + } + } elsif (m{^\s*/}) { + s/^\s+//; + my $libdir = $_; + if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) { + push @system_librarypaths, $libdir; + } + } + } + close $fh; +} + +sub blank_library_paths { + @custom_librarypaths = (); + @system_librarypaths = (); + $librarypaths_init = 1; +} + +sub setup_library_paths { + @custom_librarypaths = (); + @system_librarypaths = (); + + # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH. + if ($ENV{LD_LIBRARY_PATH}) { + require Cwd; + my $cwd = Cwd::getcwd; + + foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) { + $path =~ s{/+$}{}; + + my $realpath = Cwd::realpath($path); + next unless defined $realpath; + if ($realpath =~ m/^\Q$cwd\E/) { + warning(g_('deprecated use of LD_LIBRARY_PATH with private ' . + 'library directory which interferes with ' . + 'cross-building, please use -l option instead')); + } + + # XXX: This should be added to @custom_librarypaths, but as this + # is deprecated we do not care as the code will go away. + push @system_librarypaths, $path; + } + } + + # Adjust set of directories to consider when we're in a situation of a + # cross-build or a build of a cross-compiler. + my $multiarch; + + # Detect cross compiler builds. + if ($ENV{DEB_TARGET_GNU_TYPE} and + ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE})) + { + $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE}); + } + # Host for normal cross builds. + if (get_build_arch() ne get_host_arch()) { + $multiarch = debarch_to_multiarch(get_host_arch()); + } + # Define list of directories containing crossbuilt libraries. + if ($multiarch) { + push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch"; + } + + push @system_librarypaths, DEFAULT_LIBRARY_PATH; + + # Update library paths with ld.so config. + parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf'; + + push @system_librarypaths, DEFAULT_MULTILIB_PATH; + + $librarypaths_init = 1; +} + +sub add_library_dir { + my $dir = shift; + + setup_library_paths() if not $librarypaths_init; + + push @custom_librarypaths, $dir; +} + +sub get_library_paths { + setup_library_paths() if not $librarypaths_init; + + return (@custom_librarypaths, @system_librarypaths); +} + +# find_library ($soname, \@rpath, $format, $root) +sub find_library { + my ($lib, $rpath, $format, $root) = @_; + + setup_library_paths() if not $librarypaths_init; + + my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths); + my @libs; + + $root //= ''; + $root =~ s{/+$}{}; + foreach my $dir (@librarypaths) { + my $checkdir = "$root$dir"; + if (-e "$checkdir/$lib") { + my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib"); + if (not defined $libformat) { + warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib"); + } elsif ($format eq $libformat) { + push @libs, canonpath("$checkdir/$lib"); + } else { + debug(1, "Skipping lib $checkdir/$lib, libabi=0x%s != objabi=0x%s", + unpack('H*', $libformat), unpack('H*', $format)); + } + } + } + return @libs; +} + +1; diff --git a/scripts/Dpkg/Shlibs/Cppfilt.pm b/scripts/Dpkg/Shlibs/Cppfilt.pm new file mode 100644 index 0000000..c2a4756 --- /dev/null +++ b/scripts/Dpkg/Shlibs/Cppfilt.pm @@ -0,0 +1,120 @@ +# Copyright © 2009-2010 Modestas Vainius <modax@debian.org> +# Copyright © 2010, 2012-2015 Guillem Jover <guillem@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::Cppfilt; + +use strict; +use warnings; + +our $VERSION = '0.01'; +our @EXPORT = qw( + cppfilt_demangle_cpp +); +our @EXPORT_OK = qw( + cppfilt_demangle +); + +use Exporter qw(import); + +use Dpkg::ErrorHandling; +use Dpkg::IPC; + +# A hash of 'objects' referring to preforked c++filt processes for the distinct +# demangling types. +my %cppfilts; + +sub get_cppfilt { + my $type = shift || 'auto'; + + # Fork c++filt process for demangling $type unless it is forked already. + # Keeping c++filt running improves performance a lot. + my $filt; + if (exists $cppfilts{$type}) { + $filt = $cppfilts{$type}; + } else { + $filt = { + from => undef, + to => undef, + last_symbol => '', + last_result => '', + }; + $filt->{pid} = spawn(exec => [ 'c++filt', "--format=$type" ], + from_pipe => \$filt->{from}, + to_pipe => \$filt->{to}); + syserr(g_('unable to execute %s'), 'c++filt') + unless defined $filt->{from}; + $filt->{from}->autoflush(1); + + $cppfilts{$type} = $filt; + } + return $filt; +} + +# Demangle the given $symbol using demangler for the specified $type (defaults +# to 'auto') . Extraneous characters trailing after a mangled name are kept +# intact. If neither whole $symbol nor portion of it could be demangled, undef +# is returned. +sub cppfilt_demangle { + my ($symbol, $type) = @_; + + # Start or get c++filt 'object' for the requested type. + my $filt = get_cppfilt($type); + + # Remember the last result. Such a local optimization is cheap and useful + # when sequential pattern matching is performed. + if ($filt->{last_symbol} ne $symbol) { + # This write/read operation should not deadlock because c++filt flushes + # output buffer on LF or each invalid character. + print { $filt->{from} } $symbol, "\n"; + my $demangled = readline($filt->{to}); + chop $demangled; + + # If the symbol was not demangled, return undef + $demangled = undef if $symbol eq $demangled; + + # Remember the last result + $filt->{last_symbol} = $symbol; + $filt->{last_result} = $demangled; + } + return $filt->{last_result}; +} + +sub cppfilt_demangle_cpp { + my $symbol = shift; + return cppfilt_demangle($symbol, 'auto'); +} + +sub terminate_cppfilts { + foreach my $type (keys %cppfilts) { + next if not defined $cppfilts{$type}{pid}; + close $cppfilts{$type}{from}; + close $cppfilts{$type}{to}; + wait_child($cppfilts{$type}{pid}, cmdline => 'c++filt', + nocheck => 1, + timeout => 5); + delete $cppfilts{$type}; + } +} + +# Close/terminate running c++filt process(es) +END { + # Make sure exitcode is not changed (by wait_child) + my $exitcode = $?; + terminate_cppfilts(); + $? = $exitcode; +} + +1; diff --git a/scripts/Dpkg/Shlibs/Objdump.pm b/scripts/Dpkg/Shlibs/Objdump.pm new file mode 100644 index 0000000..c9af965 --- /dev/null +++ b/scripts/Dpkg/Shlibs/Objdump.pm @@ -0,0 +1,582 @@ +# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2007-2009,2012-2015,2017-2018 Guillem Jover <guillem@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::Objdump; + +use strict; +use warnings; +use feature qw(state); + +our $VERSION = '0.01'; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = { objects => {} }; + bless $self, $class; + return $self; +} + +sub add_object { + my ($self, $obj) = @_; + my $id = $obj->get_id; + if ($id) { + $self->{objects}{$id} = $obj; + } + return $id; +} + +sub analyze { + my ($self, $file) = @_; + my $obj = Dpkg::Shlibs::Objdump::Object->new($file); + + return $self->add_object($obj); +} + +sub locate_symbol { + my ($self, $name) = @_; + foreach my $obj (values %{$self->{objects}}) { + my $sym = $obj->get_symbol($name); + if (defined($sym) && $sym->{defined}) { + return $sym; + } + } + return; +} + +sub get_object { + my ($self, $objid) = @_; + if ($self->has_object($objid)) { + return $self->{objects}{$objid}; + } + return; +} + +sub has_object { + my ($self, $objid) = @_; + return exists $self->{objects}{$objid}; +} + +use constant { + # ELF Class. + ELF_BITS_NONE => 0, + ELF_BITS_32 => 1, + ELF_BITS_64 => 2, + + # ELF Data encoding. + ELF_ORDER_NONE => 0, + ELF_ORDER_2LSB => 1, + ELF_ORDER_2MSB => 2, + + # ELF Machine. + EM_SPARC => 2, + EM_MIPS => 8, + EM_SPARC64_OLD => 11, + EM_SPARC32PLUS => 18, + EM_PPC64 => 21, + EM_S390 => 22, + EM_ARM => 40, + EM_ALPHA_OLD => 41, + EM_SH => 42, + EM_SPARC64 => 43, + EM_IA64 => 50, + EM_AVR => 83, + EM_M32R => 88, + EM_MN10300 => 89, + EM_MN10200 => 90, + EM_OR1K => 92, + EM_XTENSA => 94, + EM_MICROBLAZE => 189, + EM_ARCV2 => 195, + EM_LOONGARCH => 258, + EM_AVR_OLD => 0x1057, + EM_OR1K_OLD => 0x8472, + EM_ALPHA => 0x9026, + EM_M32R_CYGNUS => 0x9041, + EM_S390_OLD => 0xa390, + EM_XTENSA_OLD => 0xabc7, + EM_MICROBLAZE_OLD => 0xbaab, + EM_MN10300_CYGNUS => 0xbeef, + EM_MN10200_CYGNUS => 0xdead, + + # ELF Version. + EV_NONE => 0, + EV_CURRENT => 1, + + # ELF Flags (might influence the ABI). + EF_ARM_ALIGN8 => 0x00000040, + EF_ARM_NEW_ABI => 0x00000080, + EF_ARM_OLD_ABI => 0x00000100, + EF_ARM_SOFT_FLOAT => 0x00000200, + EF_ARM_HARD_FLOAT => 0x00000400, + EF_ARM_EABI_MASK => 0xff000000, + + EF_IA64_ABI64 => 0x00000010, + + EF_LOONGARCH_SOFT_FLOAT => 0x00000001, + EF_LOONGARCH_SINGLE_FLOAT => 0x00000002, + EF_LOONGARCH_DOUBLE_FLOAT => 0x00000003, + EF_LOONGARCH_ABI_MASK => 0x00000007, + + EF_MIPS_ABI2 => 0x00000020, + EF_MIPS_32BIT => 0x00000100, + EF_MIPS_FP64 => 0x00000200, + EF_MIPS_NAN2008 => 0x00000400, + EF_MIPS_ABI_MASK => 0x0000f000, + EF_MIPS_ARCH_MASK => 0xf0000000, + + EF_PPC64_ABI64 => 0x00000003, + + EF_SH_MACH_MASK => 0x0000001f, +}; + +# These map alternative or old machine IDs to their canonical form. +my %elf_mach_map = ( + EM_ALPHA_OLD() => EM_ALPHA, + EM_AVR_OLD() => EM_AVR, + EM_M32R_CYGNUS() => EM_M32R, + EM_MICROBLAZE_OLD() => EM_MICROBLAZE, + EM_MN10200_CYGNUS() => EM_MN10200, + EM_MN10300_CYGNUS() => EM_MN10300, + EM_OR1K_OLD() => EM_OR1K, + EM_S390_OLD() => EM_S390, + EM_SPARC32PLUS() => EM_SPARC, + EM_SPARC64_OLD() => EM_SPARC64, + EM_XTENSA_OLD() => EM_XTENSA, +); + +# These masks will try to expose processor flags that are ABI incompatible, +# and as such are part of defining the architecture ABI. If uncertain it is +# always better to not mask a flag, because that preserves the historical +# behavior, and we do not drop dependencies. +my %elf_flags_mask = ( + EM_IA64() => EF_IA64_ABI64, + EM_LOONGARCH() => EF_LOONGARCH_ABI_MASK, + EM_MIPS() => EF_MIPS_ABI_MASK | EF_MIPS_ABI2, + EM_PPC64() => EF_PPC64_ABI64, +); + +sub get_format { + my ($file) = @_; + state %format; + + return $format{$file} if exists $format{$file}; + + my $header; + + open my $fh, '<', $file or syserr(g_('cannot read %s'), $file); + my $rc = read $fh, $header, 64; + if (not defined $rc) { + syserr(g_('cannot read %s'), $file); + } elsif ($rc != 64) { + return; + } + close $fh; + + my %elf; + + # Unpack the identifier field. + @elf{qw(magic bits endian vertype osabi verabi)} = unpack 'a4C5', $header; + + return unless $elf{magic} eq "\x7fELF"; + return unless $elf{vertype} == EV_CURRENT; + + my ($elf_word, $elf_endian); + if ($elf{bits} == ELF_BITS_32) { + $elf_word = 'L'; + } elsif ($elf{bits} == ELF_BITS_64) { + $elf_word = 'Q'; + } else { + return; + } + if ($elf{endian} == ELF_ORDER_2LSB) { + $elf_endian = '<'; + } elsif ($elf{endian} == ELF_ORDER_2MSB) { + $elf_endian = '>'; + } else { + return; + } + + # Unpack the endianness and size dependent fields. + my $tmpl = "x16(S2Lx[${elf_word}3]L)${elf_endian}"; + @elf{qw(type mach version flags)} = unpack $tmpl, $header; + + # Canonicalize the machine ID. + $elf{mach} = $elf_mach_map{$elf{mach}} // $elf{mach}; + + # Mask any processor flags that might not change the architecture ABI. + $elf{flags} &= $elf_flags_mask{$elf{mach}} // 0; + + # Repack for easy comparison, as a big-endian byte stream, so that + # unpacking for output gives meaningful results. + $format{$file} = pack 'C2(SL)>', @elf{qw(bits endian mach flags)}; + + return $format{$file}; +} + +sub is_elf { + my $file = shift; + open(my $file_fh, '<', $file) or syserr(g_('cannot read %s'), $file); + my ($header, $result) = ('', 0); + if (read($file_fh, $header, 4) == 4) { + $result = 1 if ($header =~ /^\177ELF$/); + } + close($file_fh); + return $result; +} + +package Dpkg::Shlibs::Objdump::Object; + +use strict; +use warnings; +use feature qw(state); + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Path qw(find_command); +use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch); + +sub new { + my $this = shift; + my $file = shift // ''; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + + $self->reset; + if ($file) { + $self->analyze($file); + } + + return $self; +} + +sub reset { + my $self = shift; + + $self->{file} = ''; + $self->{id} = ''; + $self->{HASH} = ''; + $self->{GNU_HASH} = ''; + $self->{INTERP} = 0; + $self->{SONAME} = ''; + $self->{NEEDED} = []; + $self->{RPATH} = []; + $self->{dynsyms} = {}; + $self->{flags} = {}; + $self->{dynrelocs} = {}; + + return $self; +} + +sub _select_objdump { + # Decide which objdump to call + if (get_build_arch() ne get_host_arch()) { + my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump'; + return $od if find_command($od); + } + return 'objdump'; +} + +sub analyze { + my ($self, $file) = @_; + + $file ||= $self->{file}; + return unless $file; + + $self->reset; + $self->{file} = $file; + + $self->{exec_abi} = Dpkg::Shlibs::Objdump::get_format($file); + + if (not defined $self->{exec_abi}) { + warning(g_("unknown executable format in file '%s'"), $file); + return; + } + + state $OBJDUMP = _select_objdump(); + local $ENV{LC_ALL} = 'C'; + open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file) + or syserr(g_('cannot fork for %s'), $OBJDUMP); + my $ret = $self->parse_objdump_output($objdump); + close($objdump); + return $ret; +} + +sub parse_objdump_output { + my ($self, $fh) = @_; + + my $section = 'none'; + while (<$fh>) { + s/\s*$//; + next if length == 0; + + if (/^DYNAMIC SYMBOL TABLE:/) { + $section = 'dynsym'; + next; + } elsif (/^DYNAMIC RELOCATION RECORDS/) { + $section = 'dynreloc'; + $_ = <$fh>; # Skip header + next; + } elsif (/^Dynamic Section:/) { + $section = 'dyninfo'; + next; + } elsif (/^Program Header:/) { + $section = 'program'; + next; + } elsif (/^Version definitions:/) { + $section = 'verdef'; + next; + } elsif (/^Version References:/) { + $section = 'verref'; + next; + } + + if ($section eq 'dynsym') { + $self->parse_dynamic_symbol($_); + } elsif ($section eq 'dynreloc') { + if (/^\S+\s+(\S+)\s+(.+)$/) { + $self->{dynrelocs}{$2} = $1; + } else { + warning(g_("couldn't parse dynamic relocation record: %s"), $_); + } + } elsif ($section eq 'dyninfo') { + if (/^\s*NEEDED\s+(\S+)/) { + push @{$self->{NEEDED}}, $1; + } elsif (/^\s*SONAME\s+(\S+)/) { + $self->{SONAME} = $1; + } elsif (/^\s*HASH\s+(\S+)/) { + $self->{HASH} = $1; + } elsif (/^\s*GNU_HASH\s+(\S+)/) { + $self->{GNU_HASH} = $1; + } elsif (/^\s*RUNPATH\s+(\S+)/) { + # RUNPATH takes precedence over RPATH but is + # considered after LD_LIBRARY_PATH while RPATH + # is considered before (if RUNPATH is not set). + my $runpath = $1; + $self->{RPATH} = [ split /:/, $runpath ]; + } elsif (/^\s*RPATH\s+(\S+)/) { + my $rpath = $1; + unless (scalar(@{$self->{RPATH}})) { + $self->{RPATH} = [ split /:/, $rpath ]; + } + } + } elsif ($section eq 'program') { + if (/^\s*INTERP\s+/) { + $self->{INTERP} = 1; + } + } elsif ($section eq 'none') { + if (/^\s*.+:\s*file\s+format\s+(\S+)$/) { + $self->{format} = $1; + } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:$/) { + # Parse 2 lines of "-f" + # architecture: i386, flags 0x00000112: + # EXEC_P, HAS_SYMS, D_PAGED + # start address 0x08049b50 + $_ = <$fh>; + chomp; + $self->{flags}{$_} = 1 foreach (split(/,\s*/)); + } + } + } + # Update status of dynamic symbols given the relocations that have + # been parsed after the symbols... + $self->apply_relocations(); + + return $section ne 'none'; +} + +# Output format of objdump -w -T +# +# /lib/libc.so.6: file format elf32-i386 +# +# DYNAMIC SYMBOL TABLE: +# 00056ef0 g DF .text 000000db GLIBC_2.2 getwchar +# 00000000 g DO *ABS* 00000000 GCC_3.0 GCC_3.0 +# 00069960 w DF .text 0000001e GLIBC_2.0 bcmp +# 00000000 w D *UND* 00000000 _pthread_cleanup_pop_restore +# 0000b788 g DF .text 0000008e Base .protected xine_close +# 0000b788 g DF .text 0000008e .hidden IA__g_free +# | ||||||| | | | | +# | ||||||| | | Version str (.visibility) + Symbol name +# | ||||||| | Alignment +# | ||||||| Section name (or *UND* for an undefined symbol) +# | ||||||F=Function,f=file,O=object +# | |||||d=debugging,D=dynamic +# | ||||I=Indirect +# | |||W=warning +# | ||C=constructor +# | |w=weak +# | g=global,l=local,!=both global/local +# Size of the symbol +# +# GLIBC_2.2 is the version string associated to the symbol +# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the +# symbol exist + +my $vis_re = qr/(\.protected|\.hidden|\.internal|0x\S+)/; +my $dynsym_re = qr< + ^ + [0-9a-f]+ # Symbol size + \ (.{7}) # Flags + \s+(\S+) # Section name + \s+[0-9a-f]+ # Alignment + (?:\s+(\S+))? # Version string + (?:\s+$vis_re)? # Visibility + \s+(.+) # Symbol name +>x; + +sub parse_dynamic_symbol { + my ($self, $line) = @_; + if ($line =~ $dynsym_re) { + my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5); + + # Special case if version is missing but extra visibility + # attribute replaces it in the match + if (defined($ver) and $ver =~ /^$vis_re$/) { + $vis = $ver; + $ver = ''; + } + + # Cleanup visibility field + $vis =~ s/^\.// if defined($vis); + + my $symbol = { + name => $name, + version => $ver // '', + section => $sect, + dynamic => substr($flags, 5, 1) eq 'D', + debug => substr($flags, 5, 1) eq 'd', + type => substr($flags, 6, 1), + weak => substr($flags, 1, 1) eq 'w', + local => substr($flags, 0, 1) eq 'l', + global => substr($flags, 0, 1) eq 'g', + visibility => $vis // '', + hidden => '', + defined => $sect ne '*UND*' + }; + + # Handle hidden symbols + if (defined($ver) and $ver =~ /^\((.*)\)$/) { + $ver = $1; + $symbol->{version} = $1; + $symbol->{hidden} = 1; + } + + # Register symbol + $self->add_dynamic_symbol($symbol); + } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) { + # Same start but no version and no symbol ... just ignore + } elsif ($line =~ /^REG_G\d+\s+/) { + # Ignore some s390-specific output like + # REG_G6 g R *UND* 0000000000000000 #scratch + } else { + warning(g_("couldn't parse dynamic symbol definition: %s"), $line); + } +} + +sub apply_relocations { + my $self = shift; + foreach my $sym (values %{$self->{dynsyms}}) { + # We want to mark as undefined symbols those which are currently + # defined but that depend on a copy relocation + next if not $sym->{defined}; + + my @relocs; + + # When objdump qualifies the symbol with a version it will use @ when + # the symbol is in an undefined section (which we discarded above, or + # @@ otherwise. + push @relocs, $sym->{name} . '@@' . $sym->{version} if $sym->{version}; + + # Symbols that are not versioned, or versioned but shown with objdump + # from binutils < 2.26, do not have a version appended. + push @relocs, $sym->{name}; + + foreach my $reloc (@relocs) { + next if not exists $self->{dynrelocs}{$reloc}; + next if not $self->{dynrelocs}{$reloc} =~ /^R_.*_COPY$/; + + $sym->{defined} = 0; + last; + } + } +} + +sub add_dynamic_symbol { + my ($self, $symbol) = @_; + $symbol->{objid} = $symbol->{soname} = $self->get_id(); + $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME}; + if ($symbol->{version}) { + $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol; + } else { + $self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol; + } +} + +sub get_id { + my $self = shift; + return $self->{SONAME} || $self->{file}; +} + +sub get_symbol { + my ($self, $name) = @_; + if (exists $self->{dynsyms}{$name}) { + return $self->{dynsyms}{$name}; + } + if ($name !~ /@/) { + if (exists $self->{dynsyms}{$name . '@Base'}) { + return $self->{dynsyms}{$name . '@Base'}; + } + } + return; +} + +sub get_exported_dynamic_symbols { + my $self = shift; + return grep { + $_->{defined} && $_->{dynamic} && !$_->{local} + } values %{$self->{dynsyms}}; +} + +sub get_undefined_dynamic_symbols { + my $self = shift; + return grep { + (!$_->{defined}) && $_->{dynamic} + } values %{$self->{dynsyms}}; +} + +sub get_needed_libraries { + my $self = shift; + return @{$self->{NEEDED}}; +} + +sub is_executable { + my $self = shift; + return (exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P}) || + (exists $self->{INTERP} && $self->{INTERP}); +} + +sub is_public_library { + my $self = shift; + return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC} + && exists $self->{SONAME} && $self->{SONAME}; +} + +1; diff --git a/scripts/Dpkg/Shlibs/Symbol.pm b/scripts/Dpkg/Shlibs/Symbol.pm new file mode 100644 index 0000000..e6460ce --- /dev/null +++ b/scripts/Dpkg/Shlibs/Symbol.pm @@ -0,0 +1,531 @@ +# 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; diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm b/scripts/Dpkg/Shlibs/SymbolFile.pm new file mode 100644 index 0000000..d492055 --- /dev/null +++ b/scripts/Dpkg/Shlibs/SymbolFile.pm @@ -0,0 +1,697 @@ +# 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::SymbolFile; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Version; +use Dpkg::Control::Fields; +use Dpkg::Shlibs::Symbol; +use Dpkg::Arch qw(get_host_arch); + +use parent qw(Dpkg::Interface::Storable); + +# 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); + +my %internal_symbol = ( + __bss_end__ => 1, # arm + __bss_end => 1, # arm + _bss_end__ => 1, # arm + __bss_start => 1, # ALL + __bss_start__ => 1, # arm + __data_start => 1, # arm + __do_global_ctors_aux => 1, # ia64 + __do_global_dtors_aux => 1, # ia64 + __do_jv_register_classes => 1, # ia64 + _DYNAMIC => 1, # ALL + _edata => 1, # ALL + _end => 1, # ALL + __end__ => 1, # arm + __exidx_end => 1, # armel + __exidx_start => 1, # armel + _fbss => 1, # mips, mipsel + _fdata => 1, # mips, mipsel + _fini => 1, # ALL + _ftext => 1, # mips, mipsel + _GLOBAL_OFFSET_TABLE_ => 1, # hppa, mips, mipsel + __gmon_start__ => 1, # hppa + __gnu_local_gp => 1, # mips, mipsel + _gp => 1, # mips, mipsel + _init => 1, # ALL + _PROCEDURE_LINKAGE_TABLE_ => 1, # sparc, alpha + _SDA2_BASE_ => 1, # powerpc + _SDA_BASE_ => 1, # powerpc +); + +for my $i (14 .. 31) { + # Many powerpc specific symbols + $internal_symbol{"_restfpr_$i"} = 1; + $internal_symbol{"_restfpr_$i\_x"} = 1; + $internal_symbol{"_restgpr_$i"} = 1; + $internal_symbol{"_restgpr_$i\_x"} = 1; + $internal_symbol{"_savefpr_$i"} = 1; + $internal_symbol{"_savegpr_$i"} = 1; +} + +sub symbol_is_internal { + my ($symbol, $include_groups) = @_; + + return 1 if exists $internal_symbol{$symbol}; + + # The ARM Embedded ABI spec states symbols under this namespace as + # possibly appearing in output objects. + return 1 if not ${$include_groups}{aeabi} and $symbol =~ /^__aeabi_/; + + # The GNU implementation of the OpenMP spec, specifies symbols under + # this namespace as possibly appearing in output objects. + return 1 if not ${$include_groups}{gomp} + and $symbol =~ /^\.gomp_critical_user_/; + + return 0; +} + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + my $self = \%opts; + bless $self, $class; + $self->{arch} //= get_host_arch(); + $self->clear(); + if (exists $self->{file}) { + $self->load($self->{file}) if -e $self->{file}; + } + return $self; +} + +sub get_arch { + my $self = shift; + return $self->{arch}; +} + +sub clear { + my $self = shift; + $self->{objects} = {}; +} + +sub clear_except { + my ($self, @ids) = @_; + + my %has = map { $_ => 1 } @ids; + foreach my $objid (keys %{$self->{objects}}) { + delete $self->{objects}{$objid} unless exists $has{$objid}; + } +} + +sub get_sonames { + my $self = shift; + return keys %{$self->{objects}}; +} + +sub get_symbols { + my ($self, $soname) = @_; + if (defined $soname) { + my $obj = $self->get_object($soname); + return (defined $obj) ? values %{$obj->{syms}} : (); + } else { + my @syms; + foreach my $soname ($self->get_sonames()) { + push @syms, $self->get_symbols($soname); + } + return @syms; + } +} + +sub get_patterns { + my ($self, $soname) = @_; + my @patterns; + if (defined $soname) { + my $obj = $self->get_object($soname); + foreach my $alias (values %{$obj->{patterns}{aliases}}) { + push @patterns, values %$alias; + } + return (@patterns, @{$obj->{patterns}{generic}}); + } else { + foreach my $soname ($self->get_sonames()) { + push @patterns, $self->get_patterns($soname); + } + return @patterns; + } +} + +# Create a symbol from the supplied string specification. +sub create_symbol { + my ($self, $spec, %opts) = @_; + my $symbol = (exists $opts{base}) ? $opts{base} : + Dpkg::Shlibs::Symbol->new(); + + my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) : + $symbol->parse_symbolspec($spec); + if ($ret) { + $symbol->initialize(arch => $self->get_arch()); + return $symbol; + } + return; +} + +sub add_symbol { + my ($self, $symbol, $soname) = @_; + my $object = $self->get_object($soname); + + if ($symbol->is_pattern()) { + if (my $alias_type = $symbol->get_alias_type()) { + $object->{patterns}{aliases}{$alias_type} //= {}; + # Alias hash for matching. + my $aliases = $object->{patterns}{aliases}{$alias_type}; + $aliases->{$symbol->get_symbolname()} = $symbol; + } else { + # Otherwise assume this is a generic sequential pattern. This + # should be always safe. + push @{$object->{patterns}{generic}}, $symbol; + } + return 'pattern'; + } else { + # invalidate the minimum version cache + $object->{minver_cache} = []; + $object->{syms}{$symbol->get_symbolname()} = $symbol; + return 'sym'; + } +} + +sub _new_symbol { + my $base = shift || 'Dpkg::Shlibs::Symbol'; + return (ref $base) ? $base->clone(@_) : $base->new(@_); +} + +# Option state is only used for recursive calls. +sub parse { + my ($self, $fh, $file, %opts) = @_; + my $state = $opts{state} //= {}; + + if (exists $state->{seen}) { + return if exists $state->{seen}{$file}; # Avoid include loops + } else { + $self->{file} = $file; + $state->{seen} = {}; + } + $state->{seen}{$file} = 1; + + if (not ref $state->{obj_ref}) { # Init ref to name of current object/lib + ${$state->{obj_ref}} = undef; + } + + while (<$fh>) { + chomp; + + if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) { + if (not defined ${$state->{obj_ref}}) { + error(g_('symbol information must be preceded by a header (file %s, line %s)'), $file, $.); + } + # Symbol specification + my $deprecated = ($1) ? Dpkg::Version->new($1) : 0; + my $sym = _new_symbol($state->{base_symbol}, deprecated => $deprecated); + if ($self->create_symbol($2, base => $sym)) { + $self->add_symbol($sym, ${$state->{obj_ref}}); + } else { + warning(g_('failed to parse line in %s: %s'), $file, $_); + } + } elsif (/^(\(.*\))?#include\s+"([^"]+)"/) { + my $tagspec = $1; + my $filename = $2; + my $dir = $file; + my $old_base_symbol = $state->{base_symbol}; + my $new_base_symbol; + if (defined $tagspec) { + $new_base_symbol = _new_symbol($old_base_symbol); + $new_base_symbol->parse_tagspec($tagspec); + } + $state->{base_symbol} = $new_base_symbol; + $dir =~ s{[^/]+$}{}; # Strip filename + $self->load("$dir$filename", %opts); + $state->{base_symbol} = $old_base_symbol; + } elsif (/^#|^$/) { + # Skip possible comments and empty lines + } elsif (/^\|\s*(.*)$/) { + # Alternative dependency template + push @{$self->{objects}{${$state->{obj_ref}}}{deps}}, "$1"; + } elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) { + # Add meta-fields + $self->{objects}{${$state->{obj_ref}}}{fields}{field_capitalize($1)} = $2; + } elsif (/^(\S+)\s+(.*)$/) { + # New object and dependency template + ${$state->{obj_ref}} = $1; + if (exists $self->{objects}{${$state->{obj_ref}}}) { + # Update/override infos only + $self->{objects}{${$state->{obj_ref}}}{deps} = [ "$2" ]; + } else { + # Create a new object + $self->create_object(${$state->{obj_ref}}, "$2"); + } + } else { + warning(g_('failed to parse a line in %s: %s'), $file, $_); + } + } + delete $state->{seen}{$file}; +} + +# Beware: we reuse the data structure of the provided symfile so make +# sure to not modify them after having called this function +sub merge_object_from_symfile { + my ($self, $src, $objid) = @_; + if (not $self->has_object($objid)) { + $self->{objects}{$objid} = $src->get_object($objid); + } else { + warning(g_('tried to merge the same object (%s) twice in a symfile'), $objid); + } +} + +sub output { + my ($self, $fh, %opts) = @_; + $opts{template_mode} //= 0; + $opts{with_deprecated} //= 1; + $opts{with_pattern_matches} //= 0; + my $res = ''; + foreach my $soname (sort $self->get_sonames()) { + my @deps = $self->get_dependencies($soname); + my $dep_first = shift @deps; + if (exists $opts{package} and not $opts{template_mode}) { + $dep_first =~ s/#PACKAGE#/$opts{package}/g; + } + print { $fh } "$soname $dep_first\n" if defined $fh; + $res .= "$soname $dep_first\n" if defined wantarray; + + foreach my $dep_next (@deps) { + if (exists $opts{package} and not $opts{template_mode}) { + $dep_next =~ s/#PACKAGE#/$opts{package}/g; + } + print { $fh } "| $dep_next\n" if defined $fh; + $res .= "| $dep_next\n" if defined wantarray; + } + my $f = $self->{objects}{$soname}{fields}; + foreach my $field (sort keys %{$f}) { + my $value = $f->{$field}; + if (exists $opts{package} and not $opts{template_mode}) { + $value =~ s/#PACKAGE#/$opts{package}/g; + } + print { $fh } "* $field: $value\n" if defined $fh; + $res .= "* $field: $value\n" if defined wantarray; + } + + my @symbols; + if ($opts{template_mode}) { + # Exclude symbols matching a pattern, but include patterns themselves + @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname); + push @symbols, $self->get_patterns($soname); + } else { + @symbols = $self->get_symbols($soname); + } + foreach my $sym (sort { $a->get_symboltempl() cmp + $b->get_symboltempl() } @symbols) { + next if $sym->{deprecated} and not $opts{with_deprecated}; + # Do not dump symbols from foreign arch unless dumping a template. + next if not $opts{template_mode} and + not $sym->arch_is_concerned($self->get_arch()); + # Dump symbol specification. Dump symbol tags only in template mode. + print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh; + $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray; + # Dump pattern matches as comments (if requested) + if ($opts{with_pattern_matches} && $sym->is_pattern()) { + for my $match (sort { $a->get_symboltempl() cmp + $b->get_symboltempl() } $sym->get_pattern_matches()) + { + print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh; + $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray; + } + } + } + } + return $res; +} + +# Tries to match a symbol name and/or version against the patterns defined. +# Returns a pattern which matches (if any). +sub find_matching_pattern { + my ($self, $refsym, $sonames, $inc_deprecated) = @_; + $inc_deprecated //= 0; + my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; + + my $pattern_ok = sub { + my $p = shift; + return defined $p && ($inc_deprecated || !$p->{deprecated}) && + $p->arch_is_concerned($self->get_arch()); + }; + + foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { + my $obj = $self->get_object($soname); + my ($type, $pattern); + next unless defined $obj; + + my $all_aliases = $obj->{patterns}{aliases}; + for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) { + if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}})) { + my $aliases = $all_aliases->{$type}; + my $converter = $aliases->{(keys %$aliases)[0]}; + if (my $alias = $converter->convert_to_alias($name)) { + if ($alias && exists $aliases->{$alias}) { + $pattern = $aliases->{$alias}; + last if $pattern_ok->($pattern); + $pattern = undef; # otherwise not found yet + } + } + } + } + + # Now try generic patterns and use the first that matches + if (not defined $pattern) { + for my $p (@{$obj->{patterns}{generic}}) { + if ($pattern_ok->($p) && $p->matches_rawname($name)) { + $pattern = $p; + last; + } + } + } + if (defined $pattern) { + return (wantarray) ? + ( symbol => $pattern, soname => $soname ) : $pattern; + } + } + return; +} + +# merge_symbols($object, $minver) +# Needs $Objdump->get_object($soname) as parameter +# Do not merge symbols found in the list of (arch-specific) internal symbols. +sub merge_symbols { + my ($self, $object, $minver) = @_; + + my $soname = $object->{SONAME}; + error(g_('cannot merge symbols from objects without SONAME')) + unless $soname; + + my %include_groups = (); + my $groups = $self->get_field($soname, 'Allow-Internal-Symbol-Groups'); + if (not defined $groups) { + $groups = $self->get_field($soname, 'Ignore-Blacklist-Groups'); + if (defined $groups) { + warnings::warnif('deprecated', + 'symbols file field "Ignore-Blacklist-Groups" is deprecated, ' . + 'use "Allow-Internal-Symbol-Groups" instead'); + } + } + if (defined $groups) { + $include_groups{$_} = 1 foreach (split ' ', $groups); + } + + my %dynsyms; + foreach my $sym ($object->get_exported_dynamic_symbols()) { + my $name = $sym->{name} . '@' . + ($sym->{version} ? $sym->{version} : 'Base'); + my $symobj = $self->lookup_symbol($name, $soname); + if (symbol_is_internal($sym->{name}, \%include_groups)) { + next unless defined $symobj; + + if ($symobj->has_tag('allow-internal')) { + # Allow the symbol. + } elsif ($symobj->has_tag('ignore-blacklist')) { + # Allow the symbol and warn. + warnings::warnif('deprecated', + 'symbol tag "ignore-blacklist" is deprecated, ' . + 'use "allow-internal" instead'); + } else { + # Ignore the symbol. + next; + } + } + $dynsyms{$name} = $sym; + } + + unless ($self->has_object($soname)) { + $self->create_object($soname, ''); + } + # Scan all symbols provided by the objects + my $obj = $self->get_object($soname); + # invalidate the minimum version cache - it is not sufficient to + # invalidate in add_symbol, since we might change a minimum + # version for a particular symbol without adding it + $obj->{minver_cache} = []; + foreach my $name (keys %dynsyms) { + my $sym; + if ($sym = $self->lookup_symbol($name, $obj, 1)) { + # If the symbol is already listed in the file + $sym->mark_found_in_library($minver, $self->get_arch()); + } else { + # The exact symbol is not present in the file, but it might match a + # pattern. + my $pattern = $self->find_matching_pattern($name, $obj, 1); + if (defined $pattern) { + $pattern->mark_found_in_library($minver, $self->get_arch()); + $sym = $pattern->create_pattern_match(symbol => $name); + } else { + # Symbol without any special info as no pattern matched + $sym = Dpkg::Shlibs::Symbol->new(symbol => $name, + minver => $minver); + } + $self->add_symbol($sym, $obj); + } + } + + # Process all symbols which could not be found in the library. + foreach my $sym ($self->get_symbols($soname)) { + if (not exists $dynsyms{$sym->get_symbolname()}) { + $sym->mark_not_found_in_library($minver, $self->get_arch()); + } + } + + # Deprecate patterns which didn't match anything + for my $pattern (grep { $_->get_pattern_matches() == 0 } + $self->get_patterns($soname)) { + $pattern->mark_not_found_in_library($minver, $self->get_arch()); + } +} + +sub is_empty { + my $self = shift; + return scalar(keys %{$self->{objects}}) ? 0 : 1; +} + +sub has_object { + my ($self, $soname) = @_; + return exists $self->{objects}{$soname}; +} + +sub get_object { + my ($self, $soname) = @_; + return ref($soname) ? $soname : $self->{objects}{$soname}; +} + +sub create_object { + my ($self, $soname, @deps) = @_; + $self->{objects}{$soname} = { + syms => {}, + fields => {}, + patterns => { + aliases => {}, + generic => [], + }, + deps => [ @deps ], + minver_cache => [] + }; +} + +sub get_dependency { + my ($self, $soname, $dep_id) = @_; + $dep_id //= 0; + return $self->get_object($soname)->{deps}[$dep_id]; +} + +sub get_smallest_version { + my ($self, $soname, $dep_id) = @_; + $dep_id //= 0; + my $so_object = $self->get_object($soname); + return $so_object->{minver_cache}[$dep_id] + if defined $so_object->{minver_cache}[$dep_id]; + my $minver; + foreach my $sym ($self->get_symbols($so_object)) { + next if $dep_id != $sym->{dep_id}; + $minver //= $sym->{minver}; + if (version_compare($minver, $sym->{minver}) > 0) { + $minver = $sym->{minver}; + } + } + $so_object->{minver_cache}[$dep_id] = $minver; + return $minver; +} + +sub get_dependencies { + my ($self, $soname) = @_; + return @{$self->get_object($soname)->{deps}}; +} + +sub get_field { + my ($self, $soname, $name) = @_; + if (my $obj = $self->get_object($soname)) { + if (exists $obj->{fields}{$name}) { + return $obj->{fields}{$name}; + } + } + return; +} + +# Tries to find a symbol like the $refsym and returns its descriptor. +# $refsym may also be a symbol name. +sub lookup_symbol { + my ($self, $refsym, $sonames, $inc_deprecated) = @_; + $inc_deprecated //= 0; + my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; + + foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { + if (my $obj = $self->get_object($so)) { + my $sym = $obj->{syms}{$name}; + if ($sym and ($inc_deprecated or not $sym->{deprecated})) + { + return (wantarray) ? + ( symbol => $sym, soname => $so ) : $sym; + } + } + } + return; +} + +# Tries to find a pattern like the $refpat and returns its descriptor. +# $refpat may also be a pattern spec. +sub lookup_pattern { + my ($self, $refpat, $sonames, $inc_deprecated) = @_; + $inc_deprecated //= 0; + # If $refsym is a string, we need to create a dummy ref symbol. + $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat); + + if ($refpat && $refpat->is_pattern()) { + foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { + if (my $obj = $self->get_object($soname)) { + my $pat; + if (my $type = $refpat->get_alias_type()) { + if (exists $obj->{patterns}{aliases}{$type}) { + $pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()}; + } + } elsif ($refpat->get_pattern_type() eq 'generic') { + for my $p (@{$obj->{patterns}{generic}}) { + if (($inc_deprecated || !$p->{deprecated}) && + $p->equals($refpat, versioning => 0)) + { + $pat = $p; + last; + } + } + } + if ($pat && ($inc_deprecated || !$pat->{deprecated})) { + return (wantarray) ? + (symbol => $pat, soname => $soname) : $pat; + } + } + } + } + return; +} + +# Get symbol object reference either by symbol name or by a reference object. +sub get_symbol_object { + my ($self, $refsym, $soname) = @_; + my $sym = $self->lookup_symbol($refsym, $soname, 1); + if (! defined $sym) { + $sym = $self->lookup_pattern($refsym, $soname, 1); + } + return $sym; +} + +sub get_new_symbols { + my ($self, $ref, %opts) = @_; + my $with_optional = (exists $opts{with_optional}) ? + $opts{with_optional} : 0; + my @res; + foreach my $soname ($self->get_sonames()) { + next if not $ref->has_object($soname); + + # Scan raw symbols first. + foreach my $sym (grep { ($with_optional || ! $_->is_optional()) + && $_->is_legitimate($self->get_arch()) } + $self->get_symbols($soname)) + { + my $refsym = $ref->lookup_symbol($sym, $soname, 1); + my $isnew; + if (defined $refsym) { + # If the symbol exists in the $ref symbol file, it might + # still be new if $refsym is not legitimate. + $isnew = not $refsym->is_legitimate($self->get_arch()); + } else { + # If the symbol does not exist in the $ref symbol file, it does + # not mean that it's new. It might still match a pattern in the + # symbol file. However, due to performance reasons, first check + # if the pattern that the symbol matches (if any) exists in the + # ref symbol file as well. + $isnew = not ( + ($sym->get_pattern() and $ref->lookup_pattern($sym->get_pattern(), $soname, 1)) or + $ref->find_matching_pattern($sym, $soname, 1) + ); + } + push @res, { symbol => $sym, soname => $soname } if $isnew; + } + + # Now scan patterns + foreach my $p (grep { ($with_optional || ! $_->is_optional()) + && $_->is_legitimate($self->get_arch()) } + $self->get_patterns($soname)) + { + my $refpat = $ref->lookup_pattern($p, $soname, 0); + # If reference pattern was not found or it is not legitimate, + # considering current one as new. + if (not defined $refpat or + not $refpat->is_legitimate($self->get_arch())) + { + push @res, { symbol => $p , soname => $soname }; + } + } + } + return @res; +} + +sub get_lost_symbols { + my ($self, $ref, %opts) = @_; + return $ref->get_new_symbols($self, %opts); +} + + +sub get_new_libs { + my ($self, $ref) = @_; + my @res; + foreach my $soname ($self->get_sonames()) { + push @res, $soname if not $ref->get_object($soname); + } + return @res; +} + +sub get_lost_libs { + my ($self, $ref) = @_; + return $ref->get_new_libs($self); +} + +1; |