#!/usr/pkg/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 v5.36;

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 $depstrength = 0;
my %depstrength = map { $_ => $depstrength++ } @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_invalid($oppackage);
        error(g_("invalid 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}) {
                    debug(1, "No package mapping found for $lib, " .
                             "overriding with one from canonicalized $reallib");
                    $file2pkg->{$lib} = $file2pkg->{$reallib};
                }
            }
            if (none { $_ ne '' } @{$file2pkg->{$lib}}) {
                # If the library is really not available in an installed
                # package, it might be 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(
                            filename => $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 cannot 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 is 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/;
    }
    # Do not 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 '') {
            # If the dep is unversioned.
            $stronger = 0;
        } elsif ($depseen{$dep} eq '') {
            # If the dep seen is unversioned.
            $stronger = 1;
        } 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    do not fail on missing dependency information.
  --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 should not 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_regex = 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_("cannot 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 metadata file '%s'"), $shlibfile);
    my $dep;
    while (<$shlibs_fh>) {
        s/\s*\n$//;
        next if m/^\#/;
        ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
        if (! m/$shlibs_regex/) {
            warning(g_("shared libs metadata 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 should not 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 are 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;
            # Placeholder to cache misses too, might be replaced later on.
            $cached_pkgmatch{$path} = [ '' ];
            $pkgmatch->{$path} = [ '' ];
        }
    }
    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,
        no_check => 1,
        cmdline => 'dpkg-query --search',
    );

    return $pkgmatch;
}
