scripts/dpkg-shlibdeps.pl

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