summaryrefslogtreecommitdiffstats
path: root/scripts/dpkg-shlibdeps.pl
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 14:58:51 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 14:58:51 +0000
commitcbffab246997fb5a06211dfb706b54e5ae5bb59f (patch)
tree0573c5d96f58d74d76a49c0f2a70398e389a36d3 /scripts/dpkg-shlibdeps.pl
parentInitial commit. (diff)
downloaddpkg-upstream.tar.xz
dpkg-upstream.zip
Adding upstream version 1.21.22.upstream/1.21.22upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'scripts/dpkg-shlibdeps.pl')
-rwxr-xr-xscripts/dpkg-shlibdeps.pl936
1 files changed, 936 insertions, 0 deletions
diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl
new file mode 100755
index 0000000..557a66f
--- /dev/null
+++ b/scripts/dpkg-shlibdeps.pl
@@ -0,0 +1,936 @@
+#!/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);
+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_('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')");
+ 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_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:
+ -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/^\#/;
+ 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 @files;
+ my $pkgmatch = {};
+
+ foreach my $path (@_) {
+ 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);
+
+ my $pid = open(my $dpkg_fh, '-|');
+ syserr(g_('cannot fork for %s'), 'dpkg-query --search') unless defined $pid;
+ if (!$pid) {
+ # Child process running dpkg --search and discarding errors
+ close STDERR;
+ open STDERR, '>', '/dev/null'
+ or syserr(g_('cannot open file %s'), '/dev/null');
+ $ENV{LC_ALL} = 'C';
+ exec 'dpkg-query', '--search', '--', @files
+ or syserr(g_('unable to execute %s'), 'dpkg');
+ }
+ 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);
+ return $pkgmatch;
+}