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