scripts/dpkg-shlibdeps.pl

   1 #!/usr/bin/perl
   2 #
   3 # dpkg-shlibdeps
   4 #
   5 # Copyright © 1996 Ian Jackson
   6 # Copyright © 2000 Wichert Akkerman
   7 # Copyright © 2006 Frank Lichtenheld
   8 # Copyright © 2006-2010,2012-2015 Guillem Jover <guillem@debian.org>
   9 # Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org>
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 2 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # This program is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  23
  24 use strict;
  25 use warnings;
  26 use feature qw(state);
  27
  28 use List::Util qw(any none);
  29 use Cwd qw(realpath);
  30 use File::Basename qw(dirname);
  31
  32 use Dpkg ();
  33 use Dpkg::Gettext;
  34 use Dpkg::ErrorHandling;
  35 use Dpkg::IPC;
  36 use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir
  37                   check_files_are_the_same get_control_path);
  38 use Dpkg::Version;
  39 use Dpkg::Shlibs qw(find_library get_library_paths);
  40 use Dpkg::Shlibs::Objdump;
  41 use Dpkg::Shlibs::SymbolFile;
  42 use Dpkg::Substvars;
  43 use Dpkg::Arch qw(get_host_arch);
  44 use Dpkg::BuildAPI qw(get_build_api);
  45 use Dpkg::Deps;
  46 use Dpkg::Control::Info;
  47 use Dpkg::Control::Fields;
  48
  49
  50 use constant {
  51     WARN_SYM_NOT_FOUND => 1,
  52     WARN_DEP_AVOIDABLE => 2,
  53     WARN_NOT_NEEDED => 4,
  54 };
  55
  56 # By increasing importance
  57 my @depfields = qw(Suggests Recommends Depends Pre-Depends);
  58 my $i = 0; my %depstrength = map { $_ => $i++ } @depfields;
  59
  60 textdomain('dpkg-dev');
  61
  62 my $admindir = $Dpkg::ADMINDIR;
  63 my $shlibsoverride = "$Dpkg::CONFDIR/shlibs.override";
  64 my $shlibsdefault = "$Dpkg::CONFDIR/shlibs.default";
  65 my $shlibslocal = 'debian/shlibs.local';
  66 my $packagetype = 'deb';
  67 my $dependencyfield = 'Depends';
  68 my $varlistfile = 'debian/substvars';
  69 my $varlistfilenew;
  70 my $varnameprefix = 'shlibs';
  71 my $ignore_missing_info = 0;
  72 my $warnings = WARN_SYM_NOT_FOUND | WARN_DEP_AVOIDABLE;
  73 my $debug = 0;
  74 my @exclude = ();
  75 my @priv_lib_dirs = ();
  76 my @pkg_dir_to_search = ();
  77 my @pkg_dir_to_ignore = ();
  78 my $host_arch = get_host_arch();
  79
  80 my (@pkg_shlibs, @pkg_symbols, @pkg_root_dirs);
  81
  82 my ($stdout, %exec);
  83 foreach (@ARGV) {
  84     if (m/^-T(.*)$/) {
  85         $varlistfile = $1;
  86     } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) {
  87         $varnameprefix = $1;
  88     } elsif (m/^-L(.*)$/) {
  89         $shlibslocal = $1;
  90     } elsif (m/^-l(.*)$/) {
  91         push @priv_lib_dirs, $1;
  92     } elsif (m/^-S(.*)$/) {
  93         push @pkg_dir_to_search, $1;
  94     } elsif (m/^-I(.*)$/) {
  95         push @pkg_dir_to_ignore, $1;
  96     } elsif (m/^-O$/) {
  97         $stdout = 1;
  98     } elsif (m/^-O(.+)$/) {
  99         $varlistfile = $1;
 100     } elsif (m/^-(?:\?|-help)$/) {
 101         usage(); exit(0);
 102     } elsif (m/^--version$/) {
 103         version(); exit(0);
 104     } elsif (m/^--admindir=(.*)$/) {
 105         $admindir = $1;
 106         if (not -d $admindir) {
 107             error(g_("administrative directory '%s' does not exist"), $admindir);
 108         }
 109         $ENV{DPKG_ADMINDIR} = $admindir;
 110     } elsif (m/^-d(.*)$/) {
 111         $dependencyfield = field_capitalize($1);
 112         if (not defined $depstrength{$dependencyfield}) {
 113             warning(g_("unrecognized dependency field '%s'"), $dependencyfield);
 114         }
 115     } elsif (m/^-e(.*)$/) {
 116         if (exists $exec{$1}) {
 117             # Affect the binary to the most important field
 118             if ($depstrength{$dependencyfield} > $depstrength{$exec{$1}}) {
 119                 $exec{$1} = $dependencyfield;
 120             }
 121         } else {
 122             $exec{$1} = $dependencyfield;
 123         }
 124     } elsif (m/^--ignore-missing-info$/) {
 125         $ignore_missing_info = 1;
 126     } elsif (m/^--warnings=(\d+)$/) {
 127         $warnings = $1;
 128     } elsif (m/^-t(.*)$/) {
 129         $packagetype = $1;
 130     } elsif (m/^-v$/) {
 131         $debug++;
 132     } elsif (m/^-x(.*)$/) {
 133         push @exclude, $1;
 134     } elsif (m/^-/) {
 135         usageerr(g_("unknown option '%s'"), $_);
 136     } else {
 137         if (exists $exec{$_}) {
 138             # Affect the binary to the most important field
 139             if ($depstrength{$dependencyfield} > $depstrength{$exec{$_}}) {
 140                 $exec{$_} = $dependencyfield;
 141             }
 142         } else {
 143             $exec{$_} = $dependencyfield;
 144         }
 145     }
 146 }
 147 usageerr(g_('need at least one executable')) unless scalar keys %exec;
 148
 149 report_options(debug_level => $debug);
 150
 151 sub ignore_pkgdir {
 152     my $path = shift;
 153     return any { $path =~ /^\Q$_\E/ } @pkg_dir_to_ignore;
 154 }
 155
 156 if (-d 'debian') {
 157     push @pkg_symbols, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/symbols';
 158     push @pkg_shlibs, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/shlibs';
 159     my %uniq = map { guess_pkg_root_dir($_) => 1 } (@pkg_symbols, @pkg_shlibs);
 160     push @pkg_root_dirs, keys %uniq;
 161 }
 162
 163 my $control = Dpkg::Control::Info->new();
 164 # Initialize build API level.
 165 get_build_api($control);
 166
 167 foreach my $libdir (@priv_lib_dirs) {
 168     Dpkg::Shlibs::add_library_dir($libdir);
 169 }
 170
 171 my $fields = $control->get_source();
 172 my $bd_value = deps_concat($fields->{'Build-Depends'}, $fields->{'Build-Depends-Arch'});
 173 my $build_deps = deps_parse($bd_value, build_dep => 1, reduce_restrictions => 1);
 174 error(g_('cannot parse %s field'), 'Build-Depends/Build-Depends-Arch')
 175     unless defined $build_deps;
 176
 177 my %dependencies;
 178
 179 # Statistics on soname seen in the whole run (with multiple analysis of
 180 # binaries)
 181 my %global_soname_notfound;
 182 my %global_soname_used;
 183 my %global_soname_needed;
 184
 185 # Cached data.
 186 my %shlibs_cache;
 187 my %symfile_cache;
 188 my %objdump_cache;
 189 my %symfile_has_soname_cache;
 190
 191 # Used to count errors due to missing libraries
 192 my $error_count = 0;
 193
 194 my $cur_field;
 195 foreach my $file (keys %exec) {
 196     $cur_field = $exec{$file};
 197     debug(1, ">> Scanning $file (for $cur_field field)");
 198
 199     my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
 200     my @sonames = $obj->get_needed_libraries;
 201
 202     # Load symbols files for all needed libraries (identified by SONAME)
 203     my %libfiles;
 204     my %altlibfiles;
 205     my %soname_libs;
 206     my %soname_notfound;
 207     my %alt_soname;
 208     foreach my $soname (@sonames) {
 209         my @libs = my_find_library($soname, $obj->{RPATH}, $obj->{exec_abi}, $file);
 210         unless (scalar @libs) {
 211             $soname_notfound{$soname} = 1;
 212             $global_soname_notfound{$soname} = 1;
 213             my $msg = g_('cannot find library %s needed by %s (ELF ' .
 214                          "format: '%s' abi: '%s'; RPATH: '%s')");
 215             if (scalar(split_soname($soname))) {
 216                 errormsg($msg, $soname, $file, $obj->{format}, $obj->{exec_abi},
 217                          join(':', @{$obj->{RPATH}}));
 218                 $error_count++;
 219             } else {
 220                 warning($msg, $soname, $file, $obj->{format}, $obj->{exec_abi},
 221                         join(':', @{$obj->{RPATH}}));
 222             }
 223             next;
 224         }
 225
 226         # Track shared libraries for a given SONAME.
 227         push @{$soname_libs{$soname}}, @libs;
 228
 229         # Track shared libraries for package mapping.
 230         foreach my $lib (@libs) {
 231             $libfiles{$lib} = $soname;
 232             my $reallib = realpath($lib);
 233             if ($reallib ne $lib) {
 234                 $altlibfiles{$reallib} = $soname;
 235             }
 236             debug(1, "Library $soname found in $lib");
 237         }
 238     }
 239     my $file2pkg = find_packages(keys %libfiles, keys %altlibfiles);
 240     my $symfile = Dpkg::Shlibs::SymbolFile->new();
 241     my $dumplibs_wo_symfile = Dpkg::Shlibs::Objdump->new();
 242     SONAME: foreach my $soname (@sonames) {
 243       # Select the first good entry from the ordered list that we got from
 244       # find_library(), and skip to the next SONAME.
 245
 246       foreach my $lib (@{$soname_libs{$soname}}) {
 247         if (none { $_ ne '' } @{$file2pkg->{$lib}}) {
 248             # The path of the library as calculated is not the
 249             # official path of a packaged file, try to fallback on
 250             # the realpath() first, maybe this one is part of a package
 251             my $reallib = realpath($lib);
 252             if (exists $file2pkg->{$reallib}) {
 253                 $file2pkg->{$lib} = $file2pkg->{$reallib};
 254             }
 255         }
 256         if (none { $_ ne '' } @{$file2pkg->{$lib}}) {
 257             # If the library is really not available in an installed package,
 258             # it's because it's in the process of being built
 259             # Empty package name will lead to consideration of symbols
 260             # file from the package being built only
 261             $file2pkg->{$lib} = [''];
 262             debug(1, "No associated package found for $lib");
 263         }
 264
 265         # Load symbols/shlibs files from packages providing libraries
 266         my $missing_wanted_shlibs_info = 0;
 267         foreach my $pkg (@{$file2pkg->{$lib}}) {
 268             my $symfile_path;
 269             my $haslocaldep = 0;
 270             if (-e $shlibslocal and
 271                 defined(extract_from_shlibs($soname, $shlibslocal)))
 272             {
 273                 $haslocaldep = 1;
 274             }
 275             if ($packagetype eq 'deb' and not $haslocaldep) {
 276                 # Use fine-grained dependencies only on real deb
 277                 # and only if the dependency is not provided by shlibs.local
 278                 $symfile_path = find_symbols_file($pkg, $soname, $lib);
 279             }
 280             if (defined($symfile_path)) {
 281                 # Load symbol information
 282                 debug(1, "Using symbols file $symfile_path for $soname");
 283                 $symfile_cache{$symfile_path} //=
 284                    Dpkg::Shlibs::SymbolFile->new(file => $symfile_path);
 285                 $symfile->merge_object_from_symfile($symfile_cache{$symfile_path}, $soname);
 286             }
 287             if (defined($symfile_path) && $symfile->has_object($soname)) {
 288                 # Initialize dependencies with the smallest minimal version
 289                 # of all symbols (unversioned dependency is not ok as the
 290                 # library might not have always been available in the
 291                 # package and we really need it)
 292                 my $dep = $symfile->get_dependency($soname);
 293                 my $minver = $symfile->get_smallest_version($soname) || '';
 294                 update_dependency_version($dep, $minver);
 295                 debug(2, " Minimal version of ($dep) initialized with ($minver)");
 296
 297                 # Found a symbols file for the SONAME.
 298                 next SONAME;
 299             } else {
 300                 # No symbol file found, fall back to standard shlibs
 301                 debug(1, "Using shlibs+objdump for $soname (file $lib)");
 302                 $objdump_cache{$lib} //= Dpkg::Shlibs::Objdump::Object->new($lib);
 303                 my $libobj = $objdump_cache{$lib};
 304                 my $id = $dumplibs_wo_symfile->add_object($libobj);
 305                 if (($id ne $soname) and ($id ne $lib)) {
 306                     warning(g_('%s has an unexpected SONAME (%s)'), $lib, $id);
 307                     $alt_soname{$id} = $soname;
 308                 }
 309
 310                 # Only try to generate a dependency for libraries with a SONAME
 311                 if (not $libobj->is_public_library()) {
 312                     debug(1, "Skipping shlibs+objdump info for private library $lib");
 313                     next;
 314                 }
 315
 316                 # If we found a shlibs file for the SONAME, skip to the next.
 317                 next SONAME if add_shlibs_dep($soname, $pkg, $lib);
 318
 319                 $missing_wanted_shlibs_info = 1;
 320
 321                 debug(1, "No shlibs+objdump info available, trying next package for $lib");
 322             }
 323         }
 324
 325         next if not $missing_wanted_shlibs_info;
 326
 327         # We will only reach this point, if we have found no symbols nor
 328         # shlibs files for the given SONAME.
 329
 330         # This failure is fairly new, try to be kind by
 331         # ignoring as many cases that can be safely ignored
 332         my $ignore = 0;
 333         # 1/ when the lib and the binary are in the same
 334         # package
 335         my $root_file = guess_pkg_root_dir($file);
 336         my $root_lib = guess_pkg_root_dir($lib);
 337         $ignore++ if defined $root_file and defined $root_lib
 338             and check_files_are_the_same($root_file, $root_lib);
 339         # 2/ when the lib is not versioned and can't be
 340         # handled by shlibs
 341         $ignore++ unless scalar split_soname($soname);
 342         # 3/ when we have been asked to do so
 343         $ignore++ if $ignore_missing_info;
 344         error(g_('no dependency information found for %s ' .
 345                  "(used by %s)\n" .
 346                  'Hint: check if the library actually comes ' .
 347                  'from a package.'), $lib, $file)
 348             unless $ignore;
 349       }
 350     }
 351
 352     # Scan all undefined symbols of the binary and resolve to a
 353     # dependency
 354     my %soname_used;
 355     foreach my $soname (@sonames) {
 356         # Initialize statistics
 357         $soname_used{$soname} = 0;
 358         $global_soname_used{$soname} //= 0;
 359         if (exists $global_soname_needed{$soname}) {
 360             push @{$global_soname_needed{$soname}}, $file;
 361         } else {
 362             $global_soname_needed{$soname} = [ $file ];
 363         }
 364     }
 365     my $nb_warnings = 0;
 366     my $nb_skipped_warnings = 0;
 367     # Disable warnings about missing symbols when we have not been able to
 368     # find all libs
 369     my $disable_warnings = scalar(keys(%soname_notfound));
 370     my $in_public_dir = 1;
 371     if (my $relname = relative_to_pkg_root($file)) {
 372         my $parent_dir = '/' . dirname($relname);
 373         $in_public_dir = any { $parent_dir eq $_ } get_library_paths();
 374     } else {
 375         warning(g_('binaries to analyze should already be ' .
 376                    "installed in their package's directory"));
 377     }
 378     debug(2, 'Analyzing all undefined symbols');
 379     foreach my $sym ($obj->get_undefined_dynamic_symbols()) {
 380         my $name = $sym->{name};
 381         if ($sym->{version}) {
 382             $name .= '@' . "$sym->{version}";
 383         } else {
 384             $name .= '@' . 'Base';
 385         }
 386         debug(2, " Looking up symbol $name");
 387         my %symdep = $symfile->lookup_symbol($name, \@sonames);
 388         if (keys %symdep) {
 389             my $depends = $symfile->get_dependency($symdep{soname},
 390                 $symdep{symbol}{dep_id});
 391             debug(2, " Found in symbols file of $symdep{soname} (minver: " .
 392                      "$symdep{symbol}{minver}, dep: $depends)");
 393             $soname_used{$symdep{soname}}++;
 394             $global_soname_used{$symdep{soname}}++;
 395             if (exists $alt_soname{$symdep{soname}}) {
 396                 # Also count usage on alternate soname
 397                 $soname_used{$alt_soname{$symdep{soname}}}++;
 398                 $global_soname_used{$alt_soname{$symdep{soname}}}++;
 399             }
 400             update_dependency_version($depends, $symdep{symbol}{minver});
 401         } else {
 402             my $syminfo = $dumplibs_wo_symfile->locate_symbol($name);
 403             if (not defined($syminfo)) {
 404                 debug(2, ' Not found');
 405                 next unless ($warnings & WARN_SYM_NOT_FOUND);
 406                 next if $disable_warnings;
 407                 # Complain about missing symbols only for executables
 408                 # and public libraries
 409                 if ($obj->is_executable() or $obj->is_public_library()) {
 410                     my $print_name = $name;
 411                     # Drop the default suffix for readability
 412                     $print_name =~ s/\@Base$//;
 413                     unless ($sym->{weak}) {
 414                         if ($debug or ($in_public_dir and $nb_warnings < 10)
 415                             or (not $in_public_dir and $nb_warnings < 1))
 416                         {
 417                             if ($in_public_dir) {
 418                                 warning(g_('symbol %s used by %s found in none of the ' .
 419                                            'libraries'), $print_name, $file);
 420                             } else {
 421                                 warning(g_('%s contains an unresolvable reference to ' .
 422                                            "symbol %s: it's probably a plugin"),
 423                                         $file, $print_name);
 424                             }
 425                             $nb_warnings++;
 426                         } else {
 427                             $nb_skipped_warnings++;
 428                         }
 429                     }
 430                 }
 431             } else {
 432                 debug(2, " Found in $syminfo->{soname} ($syminfo->{objid})");
 433                 if (exists $alt_soname{$syminfo->{soname}}) {
 434                     # Also count usage on alternate soname
 435                     $soname_used{$alt_soname{$syminfo->{soname}}}++;
 436                     $global_soname_used{$alt_soname{$syminfo->{soname}}}++;
 437                 }
 438                 $soname_used{$syminfo->{soname}}++;
 439                 $global_soname_used{$syminfo->{soname}}++;
 440             }
 441         }
 442     }
 443     warning(P_('%d similar warning has been skipped (use -v to see it)',
 444                '%d other similar warnings have been skipped (use -v to see ' .
 445                'them all)', $nb_skipped_warnings), $nb_skipped_warnings)
 446         if $nb_skipped_warnings;
 447     foreach my $soname (@sonames) {
 448         # Adjust minimal version of dependencies with information
 449         # extracted from build-dependencies
 450         my $dev_pkgs = $symfile->get_field($soname, 'Build-Depends-Packages') //
 451                        $symfile->get_field($soname, 'Build-Depends-Package');
 452         foreach my $dev_pkg (split /[,\s]+/, $dev_pkgs // '') {
 453             debug(1, "Updating dependencies of $soname with build-dependencies");
 454             my $minver = get_min_version_from_deps($build_deps, $dev_pkg);
 455             if (defined $minver) {
 456                 foreach my $dep ($symfile->get_dependencies($soname)) {
 457                     update_dependency_version($dep, $minver, 1);
 458                     debug(1, " Minimal version of $dep updated with $minver");
 459                 }
 460             } else {
 461                 debug(1, " No minimal version found in $dev_pkg build-dependency");
 462             }
 463         }
 464
 465         # Warn about un-NEEDED libraries
 466         unless ($soname_notfound{$soname} or $soname_used{$soname}) {
 467             # Ignore warning for libm.so.6 if also linked against libstdc++
 468             next if ($soname =~ /^libm\.so\.\d+$/ and
 469                      any { m/^libstdc\+\+\.so\.\d+/ } @sonames);
 470             next unless ($warnings & WARN_NOT_NEEDED);
 471             warning(g_('%s should not be linked against %s (it uses none of ' .
 472                        "the library's symbols)"), $file, $soname);
 473         }
 474     }
 475 }
 476
 477 # Warn of unneeded libraries at the "package" level (i.e. over all
 478 # binaries that we have inspected)
 479 foreach my $soname (keys %global_soname_needed) {
 480     unless ($global_soname_notfound{$soname} or $global_soname_used{$soname}) {
 481         next if ($soname =~ /^libm\.so\.\d+$/ and
 482                  any { m/^libstdc\+\+\.so\.\d+/ } keys %global_soname_needed);
 483         next unless ($warnings & WARN_DEP_AVOIDABLE);
 484         warning(P_('package could avoid a useless dependency if %s was not ' .
 485                    "linked against %s (it uses none of the library's symbols)",
 486                    'package could avoid a useless dependency if %s were not ' .
 487                    "linked against %s (they use none of the library's symbols)",
 488                    scalar @{$global_soname_needed{$soname}}),
 489                 join(' ', @{$global_soname_needed{$soname}}), $soname);
 490     }
 491 }
 492
 493 # Quit now if any missing libraries
 494 if ($error_count >= 1) {
 495     my $note = g_('Note: libraries are not searched in other binary packages ' .
 496                   "that do not have any shlibs or symbols file.\n" .
 497                   'To help dpkg-shlibdeps find private libraries, you might ' .
 498                   'need to use -l.');
 499     error(P_('cannot continue due to the error above',
 500              'cannot continue due to the errors listed above',
 501              $error_count) . "\n" . $note);
 502 }
 503
 504 # Open substvars file
 505
 506 my $substvars = Dpkg::Substvars->new();
 507 if ($stdout) {
 508     $varlistfilenew = '-';
 509 } else {
 510     $substvars->load($varlistfile) if -e $varlistfile;
 511     $substvars->filter(remove => sub { $_[0] =~ m/^\Q$varnameprefix\E:/ });
 512
 513     $varlistfilenew = "$varlistfile.new";
 514 }
 515
 516 # Write out the shlibs substvars
 517 my %depseen;
 518
 519 sub filter_deps {
 520     my ($dep, $field) = @_;
 521     # Skip dependencies on excluded packages
 522     foreach my $exc (@exclude) {
 523         return 0 if $dep =~ /^\s*\Q$exc\E\b/;
 524     }
 525     # Don't include dependencies if they are already
 526     # mentioned in a higher priority field
 527     if (not exists($depseen{$dep})) {
 528         $depseen{$dep} = $dependencies{$field}{$dep};
 529         return 1;
 530     } else {
 531         # Since dependencies can be versioned, we have to
 532         # verify if the dependency is stronger than the
 533         # previously seen one
 534         my $stronger;
 535         if ($depseen{$dep} eq $dependencies{$field}{$dep}) {
 536             # If both versions are the same (possibly unversioned)
 537             $stronger = 0;
 538         } elsif ($dependencies{$field}{$dep} eq '') {
 539             $stronger = 0; # If the dep is unversioned
 540         } elsif ($depseen{$dep} eq '') {
 541             $stronger = 1; # If the dep seen is unversioned
 542         } elsif (version_compare_relation($depseen{$dep}, REL_GT,
 543                                           $dependencies{$field}{$dep})) {
 544             # The version of the dep seen is stronger...
 545             $stronger = 0;
 546         } else {
 547             $stronger = 1;
 548         }
 549         $depseen{$dep} = $dependencies{$field}{$dep} if $stronger;
 550         return $stronger;
 551     }
 552 }
 553
 554 foreach my $field (reverse @depfields) {
 555     my $dep = '';
 556     if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) {
 557         $dep = join ', ',
 558             map {
 559                 # Translate dependency templates into real dependencies
 560                 my $templ = $_;
 561                 if ($dependencies{$field}{$templ}->is_valid() and
 562                     $dependencies{$field}{$templ}->as_string()) {
 563                     $templ =~ s/#MINVER#/(>= $dependencies{$field}{$templ})/g;
 564                 } else {
 565                     $templ =~ s/#MINVER#//g;
 566                 }
 567                 $templ =~ s/\s+/ /g;
 568                 $templ;
 569             } grep {
 570                 filter_deps($_, $field)
 571             } keys %{$dependencies{$field}};
 572     }
 573     if ($dep) {
 574         my $obj = deps_parse($dep);
 575         error(g_('invalid dependency got generated: %s'), $dep) unless defined $obj;
 576         $obj->sort();
 577         $substvars->set_as_used("$varnameprefix:$field", "$obj");
 578     }
 579 }
 580
 581 $substvars->save($varlistfilenew);
 582
 583 # Replace old file by new one
 584 if (!$stdout) {
 585     rename $varlistfilenew, $varlistfile
 586         or syserr(g_("install new varlist file '%s'"), $varlistfile);
 587 }
 588
 589 ##
 590 ## Functions
 591 ##
 592
 593 sub version {
 594     printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
 595
 596     printf g_('
 597 This is free software; see the GNU General Public License version 2 or
 598 later for copying conditions. There is NO warranty.
 599 ');
 600 }
 601
 602 sub usage {
 603     printf g_(
 604 'Usage: %s [<option>...] <executable>|-e<executable> [<option>...]')
 605     . "\n\n" . g_(
 606 "Positional options (order is significant):
 607   <executable>             include dependencies for <executable>,
 608   -e<executable>           (use -e if <executable> starts with '-')
 609   -d<dependency-field>     next executable(s) set shlibs:<dependency-field>.")
 610     . "\n\n" . g_(
 611 "Options:
 612   -l<library-dir>          add directory to private shared library search list.
 613   -p<varname-prefix>       set <varname-prefix>:* instead of shlibs:*.
 614   -O[<file>]               write variable settings to stdout (or <file>).
 615   -L<local-shlibs-file>    shlibs override file, not debian/shlibs.local.
 616   -T<substvars-file>       update variables here, not debian/substvars.
 617   -t<type>                 set package type (default is deb).
 618   -x<package>              exclude package from the generated dependencies.
 619   -S<package-build-dir>    search needed libraries in the given
 620                              package build directory first.
 621   -I<package-build-dir>    ignore needed libraries, shlibs and symbols files
 622                              in the given build directory.
 623   -v                       enable verbose mode (can be used multiple times).
 624   --ignore-missing-info    don't fail if dependency information can't be found.
 625   --warnings=<value>       define set of active warnings (see manual page).
 626   --admindir=<directory>   change the administrative directory.
 627   -?, --help               show this help message.
 628       --version            show the version.")
 629     . "\n\n" . g_(
 630 'Dependency fields recognized are:
 631   %s
 632 '), $Dpkg::PROGNAME, join('/', @depfields);
 633 }
 634
 635 sub get_min_version_from_deps {
 636     my ($dep, $pkg) = @_;
 637     if ($dep->isa('Dpkg::Deps::Simple')) {
 638         if (($dep->{package} eq $pkg) &&
 639             defined($dep->{relation}) &&
 640             (($dep->{relation} eq REL_GE) ||
 641              ($dep->{relation} eq REL_GT)))
 642         {
 643             return $dep->{version};
 644         }
 645         return;
 646     } else {
 647         my $res;
 648         foreach my $subdep ($dep->get_deps()) {
 649             my $minver = get_min_version_from_deps($subdep, $pkg);
 650             next if not defined $minver;
 651             if (defined $res) {
 652                 if (version_compare_relation($minver, REL_GT, $res)) {
 653                     $res = $minver;
 654                 }
 655             } else {
 656                 $res = $minver;
 657             }
 658         }
 659         return $res;
 660     }
 661 }
 662
 663 sub update_dependency_version {
 664     my ($dep, $minver, $existing_only) = @_;
 665     return if not defined($minver);
 666     $minver = Dpkg::Version->new($minver);
 667     foreach my $subdep (split /\s*,\s*/, $dep) {
 668         if (exists $dependencies{$cur_field}{$subdep} and
 669             defined($dependencies{$cur_field}{$subdep}))
 670         {
 671             if ($dependencies{$cur_field}{$subdep} eq '' or $minver ne '' and
 672                 version_compare_relation($minver, REL_GT,
 673                                          $dependencies{$cur_field}{$subdep}))
 674             {
 675                 $dependencies{$cur_field}{$subdep} = $minver;
 676             }
 677         } elsif (!$existing_only) {
 678             $dependencies{$cur_field}{$subdep} = $minver;
 679         }
 680     }
 681 }
 682
 683 sub add_shlibs_dep {
 684     my ($soname, $pkg, $libfile) = @_;
 685     my @shlibs = ($shlibslocal, $shlibsoverride);
 686     if ($pkg eq '') {
 687         # If the file is not packaged, try to find out the shlibs file in
 688         # the package being built where the lib has been found
 689         my $pkg_root = guess_pkg_root_dir($libfile);
 690         if (defined $pkg_root) {
 691             push @shlibs, "$pkg_root/DEBIAN/shlibs";
 692         }
 693         # Fallback to other shlibs files but it shouldn't be necessary
 694         push @shlibs, @pkg_shlibs;
 695     } else {
 696         my $control_file = get_control_path($pkg, 'shlibs');
 697         push @shlibs, $control_file if defined $control_file;
 698     }
 699     push @shlibs, $shlibsdefault;
 700     debug(1, " Looking up shlibs dependency of $soname provided by '$pkg'");
 701     foreach my $file (@shlibs) {
 702         next if not -e $file;
 703         my $dep = extract_from_shlibs($soname, $file);
 704         if (defined($dep)) {
 705             debug(1, " Found $dep in $file");
 706             foreach (split(/,\s*/, $dep)) {
 707                 # Note: the value is empty for shlibs based dependency
 708                 # symbol based dependency will put a valid version as value
 709                 $dependencies{$cur_field}{$_} = Dpkg::Version->new('');
 710             }
 711             return 1;
 712         }
 713     }
 714     debug(1, ' Found nothing');
 715     return 0;
 716 }
 717
 718 sub split_soname {
 719     my $soname = shift;
 720
 721     if ($soname =~ /^(.+)\.so\.(.+)$/) {
 722         # Shared library with stable <name>.so.<version> format.
 723         return wantarray ? ($1, $2) : 1;
 724     } elsif ($soname =~ /^(.+)-(\d.*)\.so$/) {
 725         # Shared library/module with unstable <name>-<version>.so format.
 726         return wantarray ? ($1, $2) : 1;
 727     } else {
 728         # Something else.
 729         return wantarray ? () : 0;
 730     }
 731 }
 732
 733 sub extract_from_shlibs {
 734     my ($soname, $shlibfile) = @_;
 735
 736     if (exists $shlibs_cache{$shlibfile}{$soname}) {
 737         return $shlibs_cache{$shlibfile}{$soname};
 738     }
 739
 740     my $shlibs_re = qr{
 741         ^\s*
 742         (?:(\S+):\s+)?              # Optional type
 743         (\S+)\s+                    # Library
 744         (\S+)                       # Version
 745         (?:
 746           \s+
 747           (\S.*\S)                  # Dependencies
 748         )?
 749         \s*$
 750     }x;
 751
 752     # Split soname in name/version
 753     my ($libname, $libversion) = split_soname($soname);
 754     unless (defined $libname) {
 755         warning(g_("can't extract name and version from library name '%s'"),
 756                 $soname);
 757         $shlibs_cache{$shlibfile}{$soname} = undef;
 758         return;
 759     }
 760     # Open shlibs file
 761     open(my $shlibs_fh, '<', $shlibfile)
 762         or syserr(g_("unable to open shared libs info file '%s'"), $shlibfile);
 763     my $dep;
 764     while (<$shlibs_fh>) {
 765         s/\s*\n$//;
 766         next if m/^\#/;
 767         ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
 768         if (!m/$shlibs_re/) {
 769             warning(g_("shared libs info file '%s' line %d: bad line '%s'"),
 770                     $shlibfile, $., $_);
 771             next;
 772         }
 773         my $depread = $4 // '';
 774         if (($libname eq $2) && ($libversion eq $3)) {
 775             # Define dep and end here if the package type explicitly
 776             # matches. Otherwise if the packagetype is not specified, use
 777             # the dep only as a default that can be overridden by a later
 778             # line
 779             if (defined($1)) {
 780                 if ($1 eq $packagetype) {
 781                     $dep = $depread;
 782                     last;
 783                 }
 784             } else {
 785                 $dep //= $depread;
 786             }
 787         }
 788     }
 789     close($shlibs_fh);
 790     $shlibs_cache{$shlibfile}{$soname} = $dep;
 791     return $dep;
 792 }
 793
 794 sub find_symbols_file {
 795     my ($pkg, $soname, $libfile) = @_;
 796     my @files;
 797     if ($pkg eq '') {
 798         # If the file is not packaged, try to find out the symbols file in
 799         # the package being built where the lib has been found
 800         my $pkg_root = guess_pkg_root_dir($libfile);
 801         if (defined $pkg_root) {
 802             push @files, "$pkg_root/DEBIAN/symbols";
 803         }
 804         # Fallback to other symbols files but it shouldn't be necessary
 805         push @files, @pkg_symbols;
 806     } else {
 807         push @files, "$Dpkg::CONFDIR/symbols/$pkg.symbols.$host_arch",
 808             "$Dpkg::CONFDIR/symbols/$pkg.symbols";
 809
 810         state %control_file_cache;
 811         if (not exists $control_file_cache{$pkg}) {
 812             $control_file_cache{$pkg} = get_control_path($pkg, 'symbols');
 813         }
 814         my $control_file = $control_file_cache{$pkg};
 815         push @files, $control_file if defined $control_file;
 816     }
 817
 818     foreach my $file (@files) {
 819         if (-e $file and symfile_has_soname($file, $soname)) {
 820             return $file;
 821         }
 822     }
 823     return;
 824 }
 825
 826 sub symfile_has_soname {
 827     my ($file, $soname) = @_;
 828
 829     if (exists $symfile_has_soname_cache{$file}{$soname}) {
 830         return $symfile_has_soname_cache{$file}{$soname};
 831     }
 832
 833     open(my $symfile_fh, '<', $file)
 834         or syserr(g_('cannot open file %s'), $file);
 835     my $result = 0;
 836     while (<$symfile_fh>) {
 837         if (/^\Q$soname\E /) {
 838             $result = 1;
 839             last;
 840         }
 841     }
 842     close($symfile_fh);
 843     $symfile_has_soname_cache{$file}{$soname} = $result;
 844     return $result;
 845 }
 846
 847 # find_library ($soname, \@rpath, $format)
 848 sub my_find_library {
 849     my ($lib, $rpath, $format, $execfile) = @_;
 850
 851     # Create real RPATH in case $ORIGIN is used
 852     # Note: ld.so also supports $PLATFORM and $LIB but they are
 853     # used in real case (yet)
 854     my $libdir = relative_to_pkg_root($execfile);
 855     my $origin;
 856     if (defined $libdir) {
 857         $origin = "/$libdir";
 858         $origin =~ s{/+[^/]*$}{};
 859     }
 860     my @RPATH = ();
 861     foreach my $path (@{$rpath}) {
 862         if ($path =~ /\$ORIGIN|\$\{ORIGIN\}/) {
 863             if (defined $origin) {
 864                 $path =~ s/\$ORIGIN/$origin/g;
 865                 $path =~ s/\$\{ORIGIN\}/$origin/g;
 866             } else {
 867                 warning(g_('$ORIGIN is used in RPATH of %s and the corresponding ' .
 868                 'directory could not be identified due to lack of DEBIAN ' .
 869                 "sub-directory in the root of package's build tree"), $execfile);
 870             }
 871         }
 872         push @RPATH, $path;
 873     }
 874
 875     # Look into the packages we're currently building in the following
 876     # order:
 877     # - package build tree of the binary which is analyzed
 878     # - package build tree given on the command line (option -S)
 879     # - other package build trees that contain either a shlibs or a
 880     #   symbols file
 881     # But ignore:
 882     # - package build tree given on the command line (option -I)
 883
 884     my @builddirs;
 885     my $pkg_root = guess_pkg_root_dir($execfile);
 886     push @builddirs, $pkg_root if defined $pkg_root;
 887     push @builddirs, @pkg_dir_to_search;
 888     push @builddirs, @pkg_root_dirs;
 889     my %dir_checked;
 890     foreach my $builddir (@builddirs) {
 891         next if defined($dir_checked{$builddir});
 892         next if ignore_pkgdir($builddir);
 893         my @libs = find_library($lib, \@RPATH, $format, $builddir);
 894         return @libs if scalar @libs;
 895         $dir_checked{$builddir} = 1;
 896     }
 897
 898     # Fallback in the root directory if we have not found what we were
 899     # looking for in the packages
 900     return find_library($lib, \@RPATH, $format, '');
 901 }
 902
 903 my %cached_pkgmatch = ();
 904
 905 sub find_packages {
 906     my @paths = @_;
 907
 908     my @files;
 909     my $pkgmatch = {};
 910
 911     foreach my $path (@paths) {
 912         if (exists $cached_pkgmatch{$path}) {
 913             $pkgmatch->{$path} = $cached_pkgmatch{$path};
 914         } else {
 915             push @files, $path;
 916             $cached_pkgmatch{$path} = ['']; # placeholder to cache misses too.
 917             $pkgmatch->{$path} = [''];      # might be replaced later on
 918         }
 919     }
 920     return $pkgmatch unless scalar(@files);
 921
 922     # Child process running dpkg --search and discarding errors
 923     my $dpkg_fh;
 924     my $pid = spawn(
 925         exec => [ 'dpkg-query', '--search', '--', @files ],
 926         env => {
 927             LC_ALL => 'C',
 928         },
 929         to_pipe => \$dpkg_fh,
 930         error_to_file => '/dev/null',
 931     );
 932     while (<$dpkg_fh>) {
 933         chomp;
 934         if (m/^local diversion |^diversion by/) {
 935             warning(g_('diversions involved - output may be incorrect'));
 936             print { *STDERR } " $_\n"
 937                 or syserr(g_('write diversion info to stderr'));
 938         } elsif (m/^([-a-z0-9+.:, ]+): (\/.*)$/) {
 939             my ($pkgs, $path) = ($1, $2);
 940             my $realpath = realpath($path);
 941             $cached_pkgmatch{$path} = $pkgmatch->{$path} = [ split /, /, $pkgs ];
 942             $cached_pkgmatch{$realpath} = $pkgmatch->{$realpath} = [ split /, /, $pkgs ];
 943         } else {
 944             warning(g_("unknown output from dpkg --search: '%s'"), $_);
 945         }
 946     }
 947     close($dpkg_fh);
 948     wait_child($pid, nocheck => 1, cmdline => 'dpkg-query --search');
 949
 950     return $pkgmatch;
 951 }