994 lines
33 KiB
Perl
Executable file
994 lines
33 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
#
|
|
# dpkg-shlibdeps
|
|
#
|
|
# Copyright © 1996 Ian Jackson
|
|
# Copyright © 2000 Wichert Akkerman
|
|
# Copyright © 2006 Frank Lichtenheld
|
|
# Copyright © 2006-2010,2012-2015 Guillem Jover <guillem@debian.org>
|
|
# Copyright © 2007, 2016 Raphaël Hertzog <hertzog@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/>.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use feature qw(state);
|
|
|
|
use List::Util qw(any none sum);
|
|
use Cwd qw(realpath);
|
|
use File::Basename qw(dirname);
|
|
|
|
use Dpkg ();
|
|
use Dpkg::Gettext;
|
|
use Dpkg::ErrorHandling;
|
|
use Dpkg::IPC;
|
|
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::BuildAPI qw(get_build_api);
|
|
use Dpkg::Package;
|
|
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,
|
|
};
|
|
|
|
my %warn2bits = (
|
|
'symbol-not-found' => WARN_SYM_NOT_FOUND,
|
|
'avoidable-dependency' => WARN_DEP_AVOIDABLE,
|
|
'useless-linkage' => WARN_NOT_NEEDED,
|
|
);
|
|
|
|
# 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 $oppackage;
|
|
my $shlibsoverride = "$Dpkg::CONFDIR/shlibs.override";
|
|
my $shlibsdefault = "$Dpkg::CONFDIR/shlibs.default";
|
|
my $shlibslocal = 'debian/shlibs.local';
|
|
my $packagetype;
|
|
my $dependencyfield;
|
|
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 @priv_lib_dirs = ();
|
|
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 @execs;
|
|
my $stdout;
|
|
|
|
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(.*)$/) {
|
|
push @priv_lib_dirs, $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(.*)$/) {
|
|
push @execs, [ $1, $dependencyfield ];
|
|
} elsif (m/^--ignore-missing-info$/) {
|
|
$ignore_missing_info = 1;
|
|
} elsif (m/^--warnings=(\d+)$/) {
|
|
$warnings = $1;
|
|
} elsif (m/^--warnings=([a-z,-]+)$/) {
|
|
$warnings = sum map { $warn2bits{$_} } split m{,}, $1;
|
|
} elsif (m/^--package=(.+)$/) {
|
|
$oppackage = $1;
|
|
my $err = pkg_name_is_illegal($oppackage);
|
|
error(g_("illegal package name '%s': %s"), $oppackage, $err) if $err;
|
|
|
|
# Exclude self.
|
|
push @exclude, $1;
|
|
} elsif (m/^-t(.*)$/) {
|
|
$packagetype = $1;
|
|
} elsif (m/^-v$/) {
|
|
$debug++;
|
|
} elsif (m/^-x(.*)$/) {
|
|
push @exclude, $1;
|
|
} elsif (m/^-/) {
|
|
usageerr(g_("unknown option '%s'"), $_);
|
|
} else {
|
|
push @execs, [ $_, $dependencyfield ];
|
|
}
|
|
}
|
|
usageerr(g_('need at least one executable')) unless scalar @execs;
|
|
|
|
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();
|
|
# Initialize build API level.
|
|
get_build_api($control);
|
|
|
|
my $default_depfield;
|
|
|
|
if (defined $oppackage) {
|
|
my $pkg = $control->get_pkg_by_name($oppackage);
|
|
if (not defined $pkg) {
|
|
error(g_('package %s not in control info'), $oppackage);
|
|
}
|
|
|
|
$packagetype //= $pkg->{'Package-Type'} ||
|
|
$pkg->get_custom_field('Package-Type');
|
|
|
|
# For essential packages we default to Pre-Depends.
|
|
if (defined $pkg->{Essential} && $pkg->{Essential} eq 'yes') {
|
|
$default_depfield = 'Pre-Depends';
|
|
}
|
|
}
|
|
|
|
$packagetype //= 'deb';
|
|
$default_depfield //= 'Depends';
|
|
|
|
my %exec;
|
|
foreach my $exec_item (@execs) {
|
|
my ($path, $depfield) = @{$exec_item};
|
|
|
|
$depfield //= $default_depfield;
|
|
|
|
if (exists $exec{$path}) {
|
|
# Affect the binary to the most important field
|
|
if ($depstrength{$depfield} > $depstrength{$exec{$path}}) {
|
|
$exec{$path} = $depfield;
|
|
}
|
|
} else {
|
|
$exec{$path} = $depfield;
|
|
}
|
|
}
|
|
|
|
foreach my $libdir (@priv_lib_dirs) {
|
|
Dpkg::Shlibs::add_library_dir($libdir);
|
|
}
|
|
|
|
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_('cannot parse %s field'), '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;
|
|
|
|
# Cached data.
|
|
my %shlibs_cache;
|
|
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')");
|
|
if (scalar(split_soname($soname))) {
|
|
errormsg($msg, $soname, $file, $obj->{format}, $obj->{exec_abi},
|
|
join(':', @{$obj->{RPATH}}));
|
|
$error_count++;
|
|
} else {
|
|
warning($msg, $soname, $file, $obj->{format}, $obj->{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;
|
|
if (not $ignore) {
|
|
errormsg(g_('no dependency information found for %s (used by %s)'),
|
|
$lib, $file);
|
|
hint(g_('check if the library actually comes from a package'));
|
|
exit 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
# 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_pkgs = $symfile->get_field($soname, 'Build-Depends-Packages') //
|
|
$symfile->get_field($soname, 'Build-Depends-Package');
|
|
foreach my $dev_pkg (split /[,\s]+/, $dev_pkgs // '') {
|
|
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 [<option>...] <executable>|-e<executable> [<option>...]')
|
|
. "\n\n" . g_(
|
|
"Positional options (order is significant):
|
|
<executable> include dependencies for <executable>,
|
|
-e<executable> (use -e if <executable> starts with '-')
|
|
-d<dependency-field> next executable(s) set shlibs:<dependency-field>.")
|
|
. "\n\n" . g_(
|
|
"Options:
|
|
--package=<package> generate substvars for <package> (default is unset).
|
|
-l<library-dir> add directory to private shared library search list.
|
|
-p<varname-prefix> set <varname-prefix>:* instead of shlibs:*.
|
|
-O[<file>] write variable settings to stdout (or <file>).
|
|
-L<local-shlibs-file> shlibs override file, not debian/shlibs.local.
|
|
-T<substvars-file> update variables here, not debian/substvars.
|
|
-t<type> set package type (default is deb).
|
|
-x<package> exclude package from the generated dependencies.
|
|
-S<package-build-dir> search needed libraries in the given
|
|
package build directory first.
|
|
-I<package-build-dir> ignore needed libraries, shlibs and symbols files
|
|
in the given build directory.
|
|
-v enable verbose mode (can be used multiple times).
|
|
--ignore-missing-info don't fail if dependency information can't be found.
|
|
--warnings=<value> define set of active warnings (see manual page).
|
|
--admindir=<directory> change the administrative directory.
|
|
-?, --help show this help message.
|
|
--version show the version.")
|
|
. "\n\n" . g_(
|
|
'Dependency fields recognized are:
|
|
%s
|
|
'), $Dpkg::PROGNAME, join('/', @depfields);
|
|
}
|
|
|
|
sub get_min_version_from_deps {
|
|
my ($dep, $pkg) = @_;
|
|
if ($dep->isa('Dpkg::Deps::Simple')) {
|
|
if (($dep->{package} eq $pkg) &&
|
|
defined($dep->{relation}) &&
|
|
(($dep->{relation} eq REL_GE) ||
|
|
($dep->{relation} eq REL_GT)))
|
|
{
|
|
return $dep->{version};
|
|
}
|
|
return;
|
|
} else {
|
|
my $res;
|
|
foreach my $subdep ($dep->get_deps()) {
|
|
my $minver = get_min_version_from_deps($subdep, $pkg);
|
|
next if not defined $minver;
|
|
if (defined $res) {
|
|
if (version_compare_relation($minver, REL_GT, $res)) {
|
|
$res = $minver;
|
|
}
|
|
} else {
|
|
$res = $minver;
|
|
}
|
|
}
|
|
return $res;
|
|
}
|
|
}
|
|
|
|
sub update_dependency_version {
|
|
my ($dep, $minver, $existing_only) = @_;
|
|
return if not defined($minver);
|
|
$minver = Dpkg::Version->new($minver);
|
|
foreach my $subdep (split /\s*,\s*/, $dep) {
|
|
if (exists $dependencies{$cur_field}{$subdep} and
|
|
defined($dependencies{$cur_field}{$subdep}))
|
|
{
|
|
if ($dependencies{$cur_field}{$subdep} eq '' or $minver ne '' and
|
|
version_compare_relation($minver, REL_GT,
|
|
$dependencies{$cur_field}{$subdep}))
|
|
{
|
|
$dependencies{$cur_field}{$subdep} = $minver;
|
|
}
|
|
} elsif (!$existing_only) {
|
|
$dependencies{$cur_field}{$subdep} = $minver;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub add_shlibs_dep {
|
|
my ($soname, $pkg, $libfile) = @_;
|
|
my @shlibs = ($shlibslocal, $shlibsoverride);
|
|
if ($pkg eq '') {
|
|
# If the file is not packaged, try to find out the shlibs file in
|
|
# the package being built where the lib has been found
|
|
my $pkg_root = guess_pkg_root_dir($libfile);
|
|
if (defined $pkg_root) {
|
|
push @shlibs, "$pkg_root/DEBIAN/shlibs";
|
|
}
|
|
# Fallback to other shlibs files but it shouldn't be necessary
|
|
push @shlibs, @pkg_shlibs;
|
|
} else {
|
|
my $control_file = get_control_path($pkg, 'shlibs');
|
|
push @shlibs, $control_file if defined $control_file;
|
|
}
|
|
push @shlibs, $shlibsdefault;
|
|
debug(1, " Looking up shlibs dependency of $soname provided by '$pkg'");
|
|
foreach my $file (@shlibs) {
|
|
next if not -e $file;
|
|
my $dep = extract_from_shlibs($soname, $file);
|
|
if (defined($dep)) {
|
|
debug(1, " Found $dep in $file");
|
|
foreach (split(/,\s*/, $dep)) {
|
|
# Note: the value is empty for shlibs based dependency
|
|
# symbol based dependency will put a valid version as value
|
|
$dependencies{$cur_field}{$_} = Dpkg::Version->new('');
|
|
}
|
|
return 1;
|
|
}
|
|
}
|
|
debug(1, ' Found nothing');
|
|
return 0;
|
|
}
|
|
|
|
sub split_soname {
|
|
my $soname = shift;
|
|
|
|
if ($soname =~ /^(.+)\.so\.(.+)$/) {
|
|
# Shared library with stable <name>.so.<version> format.
|
|
return wantarray ? ($1, $2) : 1;
|
|
} elsif ($soname =~ /^(.+)-(\d.*)\.so$/) {
|
|
# Shared library/module with unstable <name>-<version>.so format.
|
|
return wantarray ? ($1, $2) : 1;
|
|
} else {
|
|
# Something else.
|
|
return wantarray ? () : 0;
|
|
}
|
|
}
|
|
|
|
sub extract_from_shlibs {
|
|
my ($soname, $shlibfile) = @_;
|
|
|
|
if (exists $shlibs_cache{$shlibfile}{$soname}) {
|
|
return $shlibs_cache{$shlibfile}{$soname};
|
|
}
|
|
|
|
my $shlibs_re = qr{
|
|
^\s*
|
|
(?:(\S+):\s+)? # Optional type
|
|
(\S+)\s+ # Library
|
|
(\S+) # Version
|
|
(?:
|
|
\s+
|
|
(\S.*\S) # Dependencies
|
|
)?
|
|
\s*$
|
|
}x;
|
|
|
|
# Split soname in name/version
|
|
my ($libname, $libversion) = split_soname($soname);
|
|
unless (defined $libname) {
|
|
warning(g_("can't extract name and version from library name '%s'"),
|
|
$soname);
|
|
$shlibs_cache{$shlibfile}{$soname} = undef;
|
|
return;
|
|
}
|
|
# Open shlibs file
|
|
open(my $shlibs_fh, '<', $shlibfile)
|
|
or syserr(g_("unable to open shared libs info file '%s'"), $shlibfile);
|
|
my $dep;
|
|
while (<$shlibs_fh>) {
|
|
s/\s*\n$//;
|
|
next if m/^\#/;
|
|
## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
|
|
if (!m/$shlibs_re/) {
|
|
warning(g_("shared libs info file '%s' line %d: bad line '%s'"),
|
|
$shlibfile, $., $_);
|
|
next;
|
|
}
|
|
my $depread = $4 // '';
|
|
if (($libname eq $2) && ($libversion eq $3)) {
|
|
# Define dep and end here if the package type explicitly
|
|
# matches. Otherwise if the packagetype is not specified, use
|
|
# the dep only as a default that can be overridden by a later
|
|
# line
|
|
if (defined($1)) {
|
|
if ($1 eq $packagetype) {
|
|
$dep = $depread;
|
|
last;
|
|
}
|
|
} else {
|
|
$dep //= $depread;
|
|
}
|
|
}
|
|
}
|
|
close($shlibs_fh);
|
|
$shlibs_cache{$shlibfile}{$soname} = $dep;
|
|
return $dep;
|
|
}
|
|
|
|
sub find_symbols_file {
|
|
my ($pkg, $soname, $libfile) = @_;
|
|
my @files;
|
|
if ($pkg eq '') {
|
|
# If the file is not packaged, try to find out the symbols file in
|
|
# the package being built where the lib has been found
|
|
my $pkg_root = guess_pkg_root_dir($libfile);
|
|
if (defined $pkg_root) {
|
|
push @files, "$pkg_root/DEBIAN/symbols";
|
|
}
|
|
# Fallback to other symbols files but it shouldn't be necessary
|
|
push @files, @pkg_symbols;
|
|
} else {
|
|
push @files, "$Dpkg::CONFDIR/symbols/$pkg.symbols.$host_arch",
|
|
"$Dpkg::CONFDIR/symbols/$pkg.symbols";
|
|
|
|
state %control_file_cache;
|
|
if (not exists $control_file_cache{$pkg}) {
|
|
$control_file_cache{$pkg} = get_control_path($pkg, 'symbols');
|
|
}
|
|
my $control_file = $control_file_cache{$pkg};
|
|
push @files, $control_file if defined $control_file;
|
|
}
|
|
|
|
foreach my $file (@files) {
|
|
if (-e $file and symfile_has_soname($file, $soname)) {
|
|
return $file;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub symfile_has_soname {
|
|
my ($file, $soname) = @_;
|
|
|
|
if (exists $symfile_has_soname_cache{$file}{$soname}) {
|
|
return $symfile_has_soname_cache{$file}{$soname};
|
|
}
|
|
|
|
open(my $symfile_fh, '<', $file)
|
|
or syserr(g_('cannot open file %s'), $file);
|
|
my $result = 0;
|
|
while (<$symfile_fh>) {
|
|
if (/^\Q$soname\E /) {
|
|
$result = 1;
|
|
last;
|
|
}
|
|
}
|
|
close($symfile_fh);
|
|
$symfile_has_soname_cache{$file}{$soname} = $result;
|
|
return $result;
|
|
}
|
|
|
|
# find_library ($soname, \@rpath, $format)
|
|
sub my_find_library {
|
|
my ($lib, $rpath, $format, $execfile) = @_;
|
|
|
|
# Create real RPATH in case $ORIGIN is used
|
|
# Note: ld.so also supports $PLATFORM and $LIB but they are
|
|
# used in real case (yet)
|
|
my $libdir = relative_to_pkg_root($execfile);
|
|
my $origin;
|
|
if (defined $libdir) {
|
|
$origin = "/$libdir";
|
|
$origin =~ s{/+[^/]*$}{};
|
|
}
|
|
my @RPATH = ();
|
|
foreach my $path (@{$rpath}) {
|
|
if ($path =~ /\$ORIGIN|\$\{ORIGIN\}/) {
|
|
if (defined $origin) {
|
|
$path =~ s/\$ORIGIN/$origin/g;
|
|
$path =~ s/\$\{ORIGIN\}/$origin/g;
|
|
} else {
|
|
warning(g_('$ORIGIN is used in RPATH of %s and the corresponding ' .
|
|
'directory could not be identified due to lack of DEBIAN ' .
|
|
"sub-directory in the root of package's build tree"), $execfile);
|
|
}
|
|
}
|
|
push @RPATH, $path;
|
|
}
|
|
|
|
# Look into the packages we're currently building in the following
|
|
# order:
|
|
# - package build tree of the binary which is analyzed
|
|
# - package build tree given on the command line (option -S)
|
|
# - other package build trees that contain either a shlibs or a
|
|
# symbols file
|
|
# But ignore:
|
|
# - package build tree given on the command line (option -I)
|
|
|
|
my @builddirs;
|
|
my $pkg_root = guess_pkg_root_dir($execfile);
|
|
push @builddirs, $pkg_root if defined $pkg_root;
|
|
push @builddirs, @pkg_dir_to_search;
|
|
push @builddirs, @pkg_root_dirs;
|
|
my %dir_checked;
|
|
foreach my $builddir (@builddirs) {
|
|
next if defined($dir_checked{$builddir});
|
|
next if ignore_pkgdir($builddir);
|
|
my @libs = find_library($lib, \@RPATH, $format, $builddir);
|
|
return @libs if scalar @libs;
|
|
$dir_checked{$builddir} = 1;
|
|
}
|
|
|
|
# Fallback in the root directory if we have not found what we were
|
|
# looking for in the packages
|
|
return find_library($lib, \@RPATH, $format, '');
|
|
}
|
|
|
|
my %cached_pkgmatch = ();
|
|
|
|
sub find_packages {
|
|
my @paths = @_;
|
|
|
|
my @files;
|
|
my $pkgmatch = {};
|
|
|
|
foreach my $path (@paths) {
|
|
if (exists $cached_pkgmatch{$path}) {
|
|
$pkgmatch->{$path} = $cached_pkgmatch{$path};
|
|
} else {
|
|
push @files, $path;
|
|
$cached_pkgmatch{$path} = ['']; # placeholder to cache misses too.
|
|
$pkgmatch->{$path} = ['']; # might be replaced later on
|
|
}
|
|
}
|
|
return $pkgmatch unless scalar(@files);
|
|
|
|
# Child process running dpkg --search and discarding errors
|
|
my $dpkg_fh;
|
|
my $pid = spawn(
|
|
exec => [ 'dpkg-query', '--search', '--', @files ],
|
|
env => {
|
|
LC_ALL => 'C',
|
|
},
|
|
to_pipe => \$dpkg_fh,
|
|
error_to_file => '/dev/null',
|
|
);
|
|
while (<$dpkg_fh>) {
|
|
chomp;
|
|
if (m/^local diversion |^diversion by/) {
|
|
warning(g_('diversions involved - output may be incorrect'));
|
|
print { *STDERR } " $_\n"
|
|
or syserr(g_('write diversion info to stderr'));
|
|
} elsif (m/^([-a-z0-9+.:, ]+): (\/.*)$/) {
|
|
my ($pkgs, $path) = ($1, $2);
|
|
my $realpath = realpath($path);
|
|
$cached_pkgmatch{$path} = $pkgmatch->{$path} = [ split /, /, $pkgs ];
|
|
$cached_pkgmatch{$realpath} = $pkgmatch->{$realpath} = [ split /, /, $pkgs ];
|
|
} else {
|
|
warning(g_("unknown output from dpkg --search: '%s'"), $_);
|
|
}
|
|
}
|
|
close($dpkg_fh);
|
|
wait_child($pid, nocheck => 1, cmdline => 'dpkg-query --search');
|
|
|
|
return $pkgmatch;
|
|
}
|