From 9a08cbfcc1ef900a04580f35afe2a4592d7d6030 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Mon, 6 May 2024 02:45:20 +0200 Subject: Adding upstream version 1.19.8. Signed-off-by: Daniel Baumann --- scripts/dpkg-shlibdeps.pl | 924 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 924 insertions(+) create mode 100755 scripts/dpkg-shlibdeps.pl (limited to 'scripts/dpkg-shlibdeps.pl') diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl new file mode 100755 index 0000000..a318a59 --- /dev/null +++ b/scripts/dpkg-shlibdeps.pl @@ -0,0 +1,924 @@ +#!/usr/bin/perl +# +# dpkg-shlibdeps +# +# Copyright © 1996 Ian Jackson +# Copyright © 2000 Wichert Akkerman +# Copyright © 2006 Frank Lichtenheld +# Copyright © 2006-2010,2012-2015 Guillem Jover +# Copyright © 2007, 2016 Raphaël Hertzog +# +# 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 . + +use strict; +use warnings; +use feature qw(state); + +use List::Util qw(any none); +use Cwd qw(realpath); +use File::Basename qw(dirname); + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir + check_files_are_the_same get_control_path); +use Dpkg::Version; +use Dpkg::Shlibs qw(find_library get_library_paths); +use Dpkg::Shlibs::Objdump; +use Dpkg::Shlibs::SymbolFile; +use Dpkg::Substvars; +use Dpkg::Arch qw(get_host_arch); +use Dpkg::Deps; +use Dpkg::Control::Info; +use Dpkg::Control::Fields; + + +use constant { + WARN_SYM_NOT_FOUND => 1, + WARN_DEP_AVOIDABLE => 2, + WARN_NOT_NEEDED => 4, +}; + +# By increasing importance +my @depfields = qw(Suggests Recommends Depends Pre-Depends); +my $i = 0; my %depstrength = map { $_ => $i++ } @depfields; + +textdomain('dpkg-dev'); + +my $admindir = $Dpkg::ADMINDIR; +my $shlibsoverride = "$Dpkg::CONFDIR/shlibs.override"; +my $shlibsdefault = "$Dpkg::CONFDIR/shlibs.default"; +my $shlibslocal = 'debian/shlibs.local'; +my $packagetype = 'deb'; +my $dependencyfield = 'Depends'; +my $varlistfile = 'debian/substvars'; +my $varlistfilenew; +my $varnameprefix = 'shlibs'; +my $ignore_missing_info = 0; +my $warnings = WARN_SYM_NOT_FOUND | WARN_DEP_AVOIDABLE; +my $debug = 0; +my @exclude = (); +my @pkg_dir_to_search = (); +my @pkg_dir_to_ignore = (); +my $host_arch = get_host_arch(); + +my (@pkg_shlibs, @pkg_symbols, @pkg_root_dirs); + +my ($stdout, %exec); +foreach (@ARGV) { + if (m/^-T(.*)$/) { + $varlistfile = $1; + } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) { + $varnameprefix = $1; + } elsif (m/^-L(.*)$/) { + $shlibslocal = $1; + } elsif (m/^-l(.*)$/) { + Dpkg::Shlibs::add_library_dir($1); + } elsif (m/^-S(.*)$/) { + push @pkg_dir_to_search, $1; + } elsif (m/^-I(.*)$/) { + push @pkg_dir_to_ignore, $1; + } elsif (m/^-O$/) { + $stdout = 1; + } elsif (m/^-O(.+)$/) { + $varlistfile = $1; + } elsif (m/^-(?:\?|-help)$/) { + usage(); exit(0); + } elsif (m/^--version$/) { + version(); exit(0); + } elsif (m/^--admindir=(.*)$/) { + $admindir = $1; + if (not -d $admindir) { + error(g_("administrative directory '%s' does not exist"), $admindir); + } + $ENV{DPKG_ADMINDIR} = $admindir; + } elsif (m/^-d(.*)$/) { + $dependencyfield = field_capitalize($1); + if (not defined $depstrength{$dependencyfield}) { + warning(g_("unrecognized dependency field '%s'"), $dependencyfield); + } + } elsif (m/^-e(.*)$/) { + if (exists $exec{$1}) { + # Affect the binary to the most important field + if ($depstrength{$dependencyfield} > $depstrength{$exec{$1}}) { + $exec{$1} = $dependencyfield; + } + } else { + $exec{$1} = $dependencyfield; + } + } elsif (m/^--ignore-missing-info$/) { + $ignore_missing_info = 1; + } elsif (m/^--warnings=(\d+)$/) { + $warnings = $1; + } elsif (m/^-t(.*)$/) { + $packagetype = $1; + } elsif (m/^-v$/) { + $debug++; + } elsif (m/^-x(.*)$/) { + push @exclude, $1; + } elsif (m/^-/) { + usageerr(g_("unknown option '%s'"), $_); + } else { + if (exists $exec{$_}) { + # Affect the binary to the most important field + if ($depstrength{$dependencyfield} > $depstrength{$exec{$_}}) { + $exec{$_} = $dependencyfield; + } + } else { + $exec{$_} = $dependencyfield; + } + } +} +usageerr(g_('need at least one executable')) unless scalar keys %exec; + +report_options(debug_level => $debug); + +sub ignore_pkgdir { + my $path = shift; + return any { $path =~ /^\Q$_\E/ } @pkg_dir_to_ignore; +} + +if (-d 'debian') { + push @pkg_symbols, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/symbols'; + push @pkg_shlibs, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/shlibs'; + my %uniq = map { guess_pkg_root_dir($_) => 1 } (@pkg_symbols, @pkg_shlibs); + push @pkg_root_dirs, keys %uniq; +} + +my $control = Dpkg::Control::Info->new(); +my $fields = $control->get_source(); +my $bd_value = deps_concat($fields->{'Build-Depends'}, $fields->{'Build-Depends-Arch'}); +my $build_deps = deps_parse($bd_value, build_dep => 1, reduce_restrictions => 1); +error(g_('error occurred while parsing %s'), 'Build-Depends/Build-Depends-Arch') + unless defined $build_deps; + +my %dependencies; + +# Statistics on soname seen in the whole run (with multiple analysis of +# binaries) +my %global_soname_notfound; +my %global_soname_used; +my %global_soname_needed; + +# Symfile and objdump caches +my %symfile_cache; +my %objdump_cache; +my %symfile_has_soname_cache; + +# Used to count errors due to missing libraries +my $error_count = 0; + +my $cur_field; +foreach my $file (keys %exec) { + $cur_field = $exec{$file}; + debug(1, ">> Scanning $file (for $cur_field field)"); + + my $obj = Dpkg::Shlibs::Objdump::Object->new($file); + my @sonames = $obj->get_needed_libraries; + + # Load symbols files for all needed libraries (identified by SONAME) + my %libfiles; + my %altlibfiles; + my %soname_libs; + my %soname_notfound; + my %alt_soname; + foreach my $soname (@sonames) { + my @libs = my_find_library($soname, $obj->{RPATH}, $obj->{exec_abi}, $file); + unless (scalar @libs) { + $soname_notfound{$soname} = 1; + $global_soname_notfound{$soname} = 1; + my $msg = g_('cannot find library %s needed by %s (ELF ' . + "format: '%s' abi: '%s'; RPATH: '%s')"); + my $exec_abi = unpack 'H*', $obj->{exec_abi}; + if (scalar(split_soname($soname))) { + errormsg($msg, $soname, $file, $obj->{format}, $exec_abi, join(':', @{$obj->{RPATH}})); + $error_count++; + } else { + warning($msg, $soname, $file, $obj->{format}, $exec_abi, join(':', @{$obj->{RPATH}})); + } + next; + } + + # Track shared libraries for a given SONAME. + push @{$soname_libs{$soname}}, @libs; + + # Track shared libraries for package mapping. + foreach my $lib (@libs) { + $libfiles{$lib} = $soname; + my $reallib = realpath($lib); + if ($reallib ne $lib) { + $altlibfiles{$reallib} = $soname; + } + debug(1, "Library $soname found in $lib"); + } + } + my $file2pkg = find_packages(keys %libfiles, keys %altlibfiles); + my $symfile = Dpkg::Shlibs::SymbolFile->new(); + my $dumplibs_wo_symfile = Dpkg::Shlibs::Objdump->new(); + SONAME: foreach my $soname (@sonames) { + # Select the first good entry from the ordered list that we got from + # find_library(), and skip to the next SONAME. + + foreach my $lib (@{$soname_libs{$soname}}) { + if (none { $_ ne '' } @{$file2pkg->{$lib}}) { + # The path of the library as calculated is not the + # official path of a packaged file, try to fallback on + # the realpath() first, maybe this one is part of a package + my $reallib = realpath($lib); + if (exists $file2pkg->{$reallib}) { + $file2pkg->{$lib} = $file2pkg->{$reallib}; + } + } + if (none { $_ ne '' } @{$file2pkg->{$lib}}) { + # If the library is really not available in an installed package, + # it's because it's in the process of being built + # Empty package name will lead to consideration of symbols + # file from the package being built only + $file2pkg->{$lib} = ['']; + debug(1, "No associated package found for $lib"); + } + + # Load symbols/shlibs files from packages providing libraries + my $missing_wanted_shlibs_info = 0; + foreach my $pkg (@{$file2pkg->{$lib}}) { + my $symfile_path; + my $haslocaldep = 0; + if (-e $shlibslocal and + defined(extract_from_shlibs($soname, $shlibslocal))) + { + $haslocaldep = 1; + } + if ($packagetype eq 'deb' and not $haslocaldep) { + # Use fine-grained dependencies only on real deb + # and only if the dependency is not provided by shlibs.local + $symfile_path = find_symbols_file($pkg, $soname, $lib); + } + if (defined($symfile_path)) { + # Load symbol information + debug(1, "Using symbols file $symfile_path for $soname"); + $symfile_cache{$symfile_path} //= + Dpkg::Shlibs::SymbolFile->new(file => $symfile_path); + $symfile->merge_object_from_symfile($symfile_cache{$symfile_path}, $soname); + } + if (defined($symfile_path) && $symfile->has_object($soname)) { + # Initialize dependencies with the smallest minimal version + # of all symbols (unversioned dependency is not ok as the + # library might not have always been available in the + # package and we really need it) + my $dep = $symfile->get_dependency($soname); + my $minver = $symfile->get_smallest_version($soname) || ''; + update_dependency_version($dep, $minver); + debug(2, " Minimal version of ($dep) initialized with ($minver)"); + + # Found a symbols file for the SONAME. + next SONAME; + } else { + # No symbol file found, fall back to standard shlibs + debug(1, "Using shlibs+objdump for $soname (file $lib)"); + $objdump_cache{$lib} //= Dpkg::Shlibs::Objdump::Object->new($lib); + my $libobj = $objdump_cache{$lib}; + my $id = $dumplibs_wo_symfile->add_object($libobj); + if (($id ne $soname) and ($id ne $lib)) { + warning(g_('%s has an unexpected SONAME (%s)'), $lib, $id); + $alt_soname{$id} = $soname; + } + + # Only try to generate a dependency for libraries with a SONAME + if (not $libobj->is_public_library()) { + debug(1, "Skipping shlibs+objdump info for private library $lib"); + next; + } + + # If we found a shlibs file for the SONAME, skip to the next. + next SONAME if add_shlibs_dep($soname, $pkg, $lib); + + $missing_wanted_shlibs_info = 1; + + debug(1, "No shlibs+objdump info available, trying next package for $lib"); + } + } + + next if not $missing_wanted_shlibs_info; + + # We will only reach this point, if we have found no symbols nor + # shlibs files for the given SONAME. + + # This failure is fairly new, try to be kind by + # ignoring as many cases that can be safely ignored + my $ignore = 0; + # 1/ when the lib and the binary are in the same + # package + my $root_file = guess_pkg_root_dir($file); + my $root_lib = guess_pkg_root_dir($lib); + $ignore++ if defined $root_file and defined $root_lib + and check_files_are_the_same($root_file, $root_lib); + # 2/ when the lib is not versioned and can't be + # handled by shlibs + $ignore++ unless scalar split_soname($soname); + # 3/ when we have been asked to do so + $ignore++ if $ignore_missing_info; + error(g_('no dependency information found for %s ' . + "(used by %s)\n" . + 'Hint: check if the library actually comes ' . + 'from a package.'), $lib, $file) + unless $ignore; + } + } + + # Scan all undefined symbols of the binary and resolve to a + # dependency + my %soname_used; + foreach my $soname (@sonames) { + # Initialize statistics + $soname_used{$soname} = 0; + $global_soname_used{$soname} //= 0; + if (exists $global_soname_needed{$soname}) { + push @{$global_soname_needed{$soname}}, $file; + } else { + $global_soname_needed{$soname} = [ $file ]; + } + } + my $nb_warnings = 0; + my $nb_skipped_warnings = 0; + # Disable warnings about missing symbols when we have not been able to + # find all libs + my $disable_warnings = scalar(keys(%soname_notfound)); + my $in_public_dir = 1; + if (my $relname = relative_to_pkg_root($file)) { + my $parent_dir = '/' . dirname($relname); + $in_public_dir = any { $parent_dir eq $_ } get_library_paths(); + } else { + warning(g_('binaries to analyze should already be ' . + "installed in their package's directory")); + } + debug(2, 'Analyzing all undefined symbols'); + foreach my $sym ($obj->get_undefined_dynamic_symbols()) { + my $name = $sym->{name}; + if ($sym->{version}) { + $name .= '@' . "$sym->{version}"; + } else { + $name .= '@' . 'Base'; + } + debug(2, " Looking up symbol $name"); + my %symdep = $symfile->lookup_symbol($name, \@sonames); + if (keys %symdep) { + my $depends = $symfile->get_dependency($symdep{soname}, + $symdep{symbol}{dep_id}); + debug(2, " Found in symbols file of $symdep{soname} (minver: " . + "$symdep{symbol}{minver}, dep: $depends)"); + $soname_used{$symdep{soname}}++; + $global_soname_used{$symdep{soname}}++; + if (exists $alt_soname{$symdep{soname}}) { + # Also count usage on alternate soname + $soname_used{$alt_soname{$symdep{soname}}}++; + $global_soname_used{$alt_soname{$symdep{soname}}}++; + } + update_dependency_version($depends, $symdep{symbol}{minver}); + } else { + my $syminfo = $dumplibs_wo_symfile->locate_symbol($name); + if (not defined($syminfo)) { + debug(2, ' Not found'); + next unless ($warnings & WARN_SYM_NOT_FOUND); + next if $disable_warnings; + # Complain about missing symbols only for executables + # and public libraries + if ($obj->is_executable() or $obj->is_public_library()) { + my $print_name = $name; + # Drop the default suffix for readability + $print_name =~ s/\@Base$//; + unless ($sym->{weak}) { + if ($debug or ($in_public_dir and $nb_warnings < 10) + or (not $in_public_dir and $nb_warnings < 1)) + { + if ($in_public_dir) { + warning(g_('symbol %s used by %s found in none of the ' . + 'libraries'), $print_name, $file); + } else { + warning(g_('%s contains an unresolvable reference to ' . + "symbol %s: it's probably a plugin"), + $file, $print_name); + } + $nb_warnings++; + } else { + $nb_skipped_warnings++; + } + } + } + } else { + debug(2, " Found in $syminfo->{soname} ($syminfo->{objid})"); + if (exists $alt_soname{$syminfo->{soname}}) { + # Also count usage on alternate soname + $soname_used{$alt_soname{$syminfo->{soname}}}++; + $global_soname_used{$alt_soname{$syminfo->{soname}}}++; + } + $soname_used{$syminfo->{soname}}++; + $global_soname_used{$syminfo->{soname}}++; + } + } + } + warning(P_('%d similar warning has been skipped (use -v to see it)', + '%d other similar warnings have been skipped (use -v to see ' . + 'them all)', $nb_skipped_warnings), $nb_skipped_warnings) + if $nb_skipped_warnings; + foreach my $soname (@sonames) { + # Adjust minimal version of dependencies with information + # extracted from build-dependencies + my $dev_pkg = $symfile->get_field($soname, 'Build-Depends-Package'); + if (defined $dev_pkg) { + debug(1, "Updating dependencies of $soname with build-dependencies"); + my $minver = get_min_version_from_deps($build_deps, $dev_pkg); + if (defined $minver) { + foreach my $dep ($symfile->get_dependencies($soname)) { + update_dependency_version($dep, $minver, 1); + debug(1, " Minimal version of $dep updated with $minver"); + } + } else { + debug(1, " No minimal version found in $dev_pkg build-dependency"); + } + } + + # Warn about un-NEEDED libraries + unless ($soname_notfound{$soname} or $soname_used{$soname}) { + # Ignore warning for libm.so.6 if also linked against libstdc++ + next if ($soname =~ /^libm\.so\.\d+$/ and + any { m/^libstdc\+\+\.so\.\d+/ } @sonames); + next unless ($warnings & WARN_NOT_NEEDED); + warning(g_('%s should not be linked against %s (it uses none of ' . + "the library's symbols)"), $file, $soname); + } + } +} + +# Warn of unneeded libraries at the "package" level (i.e. over all +# binaries that we have inspected) +foreach my $soname (keys %global_soname_needed) { + unless ($global_soname_notfound{$soname} or $global_soname_used{$soname}) { + next if ($soname =~ /^libm\.so\.\d+$/ and + any { m/^libstdc\+\+\.so\.\d+/ } keys %global_soname_needed); + next unless ($warnings & WARN_DEP_AVOIDABLE); + warning(P_('package could avoid a useless dependency if %s was not ' . + "linked against %s (it uses none of the library's symbols)", + 'package could avoid a useless dependency if %s were not ' . + "linked against %s (they use none of the library's symbols)", + scalar @{$global_soname_needed{$soname}}), + join(' ', @{$global_soname_needed{$soname}}), $soname); + } +} + +# Quit now if any missing libraries +if ($error_count >= 1) { + my $note = g_('Note: libraries are not searched in other binary packages ' . + "that do not have any shlibs or symbols file.\n" . + 'To help dpkg-shlibdeps find private libraries, you might ' . + 'need to use -l.'); + error(P_('cannot continue due to the error above', + 'cannot continue due to the errors listed above', + $error_count) . "\n" . $note); +} + +# Open substvars file + +my $substvars = Dpkg::Substvars->new(); +if ($stdout) { + $varlistfilenew = '-'; +} else { + $substvars->load($varlistfile) if -e $varlistfile; + $substvars->filter(remove => sub { $_[0] =~ m/^\Q$varnameprefix\E:/ }); + + $varlistfilenew = "$varlistfile.new"; +} + +# Write out the shlibs substvars +my %depseen; + +sub filter_deps { + my ($dep, $field) = @_; + # Skip dependencies on excluded packages + foreach my $exc (@exclude) { + return 0 if $dep =~ /^\s*\Q$exc\E\b/; + } + # Don't include dependencies if they are already + # mentioned in a higher priority field + if (not exists($depseen{$dep})) { + $depseen{$dep} = $dependencies{$field}{$dep}; + return 1; + } else { + # Since dependencies can be versioned, we have to + # verify if the dependency is stronger than the + # previously seen one + my $stronger; + if ($depseen{$dep} eq $dependencies{$field}{$dep}) { + # If both versions are the same (possibly unversioned) + $stronger = 0; + } elsif ($dependencies{$field}{$dep} eq '') { + $stronger = 0; # If the dep is unversioned + } elsif ($depseen{$dep} eq '') { + $stronger = 1; # If the dep seen is unversioned + } elsif (version_compare_relation($depseen{$dep}, REL_GT, + $dependencies{$field}{$dep})) { + # The version of the dep seen is stronger... + $stronger = 0; + } else { + $stronger = 1; + } + $depseen{$dep} = $dependencies{$field}{$dep} if $stronger; + return $stronger; + } +} + +foreach my $field (reverse @depfields) { + my $dep = ''; + if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) { + $dep = join ', ', + map { + # Translate dependency templates into real dependencies + my $templ = $_; + if ($dependencies{$field}{$templ}->is_valid() and + $dependencies{$field}{$templ}->as_string()) { + $templ =~ s/#MINVER#/(>= $dependencies{$field}{$templ})/g; + } else { + $templ =~ s/#MINVER#//g; + } + $templ =~ s/\s+/ /g; + $templ; + } grep { + filter_deps($_, $field) + } keys %{$dependencies{$field}}; + } + if ($dep) { + my $obj = deps_parse($dep); + error(g_('invalid dependency got generated: %s'), $dep) unless defined $obj; + $obj->sort(); + $substvars->set_as_used("$varnameprefix:$field", "$obj"); + } +} + +$substvars->save($varlistfilenew); + +# Replace old file by new one +if (!$stdout) { + rename $varlistfilenew, $varlistfile + or syserr(g_("install new varlist file '%s'"), $varlistfile); +} + +## +## Functions +## + +sub version { + printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; + + printf g_(' +This is free software; see the GNU General Public License version 2 or +later for copying conditions. There is NO warranty. +'); +} + +sub usage { + printf g_( +'Usage: %s [