|
|
@@ -1,41 +1,270 @@
|
|
|
-#! /usr/bin/perl
|
|
|
-#
|
|
|
-# dpkg-shlibdeps
|
|
|
-# $Id$
|
|
|
+#!/usr/bin/perl -w
|
|
|
|
|
|
use strict;
|
|
|
use warnings;
|
|
|
|
|
|
+use File::Find;
|
|
|
+
|
|
|
our $progname;
|
|
|
-our $version = "1.4.1.19"; # This line modified by Makefile
|
|
|
-our $dpkglibdir = "/usr/lib/dpkg";
|
|
|
+our $version;
|
|
|
+our $dpkglibdir;
|
|
|
my $admindir = "/var/lib/dpkg";
|
|
|
|
|
|
-use English;
|
|
|
-use POSIX qw(:errno_h :signal_h);
|
|
|
+BEGIN {
|
|
|
+ $version="1.14.4"; # This line modified by Makefile
|
|
|
+ $dpkglibdir="/usr/lib/dpkg"; # This line modified by Makefile
|
|
|
+ push(@INC,$dpkglibdir);
|
|
|
+}
|
|
|
+
|
|
|
+use Dpkg::Version qw(compare_versions);
|
|
|
+use Dpkg::Shlibs qw(find_library);
|
|
|
+use Dpkg::Shlibs::Objdump;
|
|
|
+use Dpkg::Shlibs::SymbolFile;
|
|
|
+
|
|
|
+our $host_arch= `dpkg-architecture -qDEB_HOST_ARCH`;
|
|
|
+chomp $host_arch;
|
|
|
+
|
|
|
+my @depfields= qw(Suggests Recommends Depends Pre-Depends); # By increasing importance
|
|
|
+my $i=0; my %depstrength = map { $_ => $i++ } @depfields;
|
|
|
+
|
|
|
+require 'controllib.pl';
|
|
|
+require 'dpkg-gettext.pl';
|
|
|
+textdomain("dpkg-dev");
|
|
|
|
|
|
my $shlibsoverride= '/etc/dpkg/shlibs.override';
|
|
|
my $shlibsdefault= '/etc/dpkg/shlibs.default';
|
|
|
my $shlibslocal= 'debian/shlibs.local';
|
|
|
-my $shlibsppdir;
|
|
|
-my $shlibsppext= '.shlibs';
|
|
|
-my $varnameprefix= 'shlibs';
|
|
|
+my $packagetype= 'deb';
|
|
|
my $dependencyfield= 'Depends';
|
|
|
my $varlistfile= 'debian/substvars';
|
|
|
-my $packagetype= 'deb';
|
|
|
+my $varnameprefix= 'shlibs';
|
|
|
+my $debug= 0;
|
|
|
+
|
|
|
+my (@pkg_shlibs, @pkg_symbols);
|
|
|
+if (-d "debian") {
|
|
|
+ find sub {
|
|
|
+ push @pkg_shlibs, $File::Find::name if ($File::Find::name =~ m{/DEBIAN/shlibs$});
|
|
|
+ push @pkg_symbols, $File::Find::name if ($File::Find::name =~ m{/DEBIAN/symbols$});
|
|
|
+ }, "debian";
|
|
|
+}
|
|
|
+
|
|
|
+my ($stdout, %exec);
|
|
|
+foreach (@ARGV) {
|
|
|
+ if (m/^-T(.*)$/) {
|
|
|
+ $varlistfile= $1;
|
|
|
+ } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) {
|
|
|
+ $varnameprefix= $1;
|
|
|
+ } elsif (m/^-L(.*)$/) {
|
|
|
+ $shlibslocal= $1;
|
|
|
+ } elsif (m/^-O$/) {
|
|
|
+ $stdout= 1;
|
|
|
+ } elsif (m/^-(h|-help)$/) {
|
|
|
+ usage(); exit(0);
|
|
|
+ } elsif (m/^--version$/) {
|
|
|
+ version(); exit(0);
|
|
|
+ } elsif (m/^--admindir=(.*)$/) {
|
|
|
+ $admindir = $1;
|
|
|
+ -d $admindir ||
|
|
|
+ error(sprintf(_g("administrative directory '%s' does not exist"),
|
|
|
+ $admindir));
|
|
|
+ } elsif (m/^-d(.*)$/) {
|
|
|
+ $dependencyfield= capit($1);
|
|
|
+ defined($depstrength{$dependencyfield}) ||
|
|
|
+ warning(sprintf(_g("unrecognised dependency field \`%s'"), $dependencyfield));
|
|
|
+ } elsif (m/^-e(.*)$/) {
|
|
|
+ $exec{$1} = $dependencyfield;
|
|
|
+ } elsif (m/^-t(.*)$/) {
|
|
|
+ $packagetype = $1;
|
|
|
+ } elsif (m/-v$/) {
|
|
|
+ $debug = 1;
|
|
|
+ } elsif (m/^-/) {
|
|
|
+ usageerr(sprintf(_g("unknown option \`%s'"), $_));
|
|
|
+ } else {
|
|
|
+ $exec{$_} = $dependencyfield;
|
|
|
+ }
|
|
|
+}
|
|
|
|
|
|
-my @depfields= qw(Suggests Recommends Depends Pre-Depends);
|
|
|
-my %depstrength;
|
|
|
-my $i=0; grep($depstrength{$_}= ++$i, @depfields);
|
|
|
+scalar keys %exec || usageerr(_g("need at least one executable"));
|
|
|
|
|
|
-push(@INC,$dpkglibdir);
|
|
|
-require 'controllib.pl';
|
|
|
+my %dependencies;
|
|
|
+my %shlibs;
|
|
|
|
|
|
-require 'dpkg-gettext.pl';
|
|
|
-textdomain("dpkg-dev");
|
|
|
+my $cur_field;
|
|
|
+foreach my $file (keys %exec) {
|
|
|
+ $cur_field = $exec{$file};
|
|
|
+ print "Scanning $file (for $cur_field field)\n" if $debug;
|
|
|
|
|
|
-#use strict;
|
|
|
-#use warnings;
|
|
|
+ my $dump = Dpkg::Shlibs::Objdump->new();
|
|
|
+ my $id = $dump->parse($file);
|
|
|
+ my $obj = $dump->get_object($id);
|
|
|
+
|
|
|
+ # Load symbols files for all needed libraries (identified by SONAME)
|
|
|
+ my %libfiles;
|
|
|
+ foreach my $soname ($obj->get_needed_libraries) {
|
|
|
+ my $file = my_find_library($soname, $obj->{RPATH}, $obj->{format});
|
|
|
+ warning("Couldn't find library $soname.") unless defined($file);
|
|
|
+ $libfiles{$file} = $soname if defined($file);
|
|
|
+ }
|
|
|
+ my $file2pkg = find_packages(keys %libfiles);
|
|
|
+ my $symfile = Dpkg::Shlibs::SymbolFile->new();
|
|
|
+ my $dumplibs_wo_symfile = Dpkg::Shlibs::Objdump->new();
|
|
|
+ my @soname_wo_symfile;
|
|
|
+ foreach my $file (keys %libfiles) {
|
|
|
+ my $soname = $libfiles{$file};
|
|
|
+ if (not exists $file2pkg->{$file}) {
|
|
|
+ # If the library is not available in an installed package,
|
|
|
+ # it's because it's in the process of being built
|
|
|
+ # Empty package name will lead to consideration of symbols
|
|
|
+ # file from the package being built only
|
|
|
+ $file2pkg->{$file} = [""];
|
|
|
+ }
|
|
|
+
|
|
|
+ # Load symbols/shlibs files from packages providing libraries
|
|
|
+ foreach my $pkg (@{$file2pkg->{$file}}) {
|
|
|
+ my $dpkg_symfile;
|
|
|
+ if ($packagetype eq "deb") {
|
|
|
+ # Use fine-grained dependencies only on real deb
|
|
|
+ $dpkg_symfile = find_symbols_file($pkg, $soname);
|
|
|
+ }
|
|
|
+ if (defined $dpkg_symfile) {
|
|
|
+ # Load symbol information
|
|
|
+ print "Using symbols file $dpkg_symfile for $soname\n" if $debug;
|
|
|
+ $symfile->load($dpkg_symfile);
|
|
|
+ # Initialize dependencies as an unversioned dependency
|
|
|
+ my $dep = $symfile->get_dependency($soname);
|
|
|
+ foreach my $subdep (split /\s*,\s*/, $dep) {
|
|
|
+ if (not exists $dependencies{$cur_field}{$subdep}) {
|
|
|
+ $dependencies{$cur_field}{$subdep} = '';
|
|
|
+ }
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ # No symbol file found, fall back to standard shlibs
|
|
|
+ $dumplibs_wo_symfile->parse($file);
|
|
|
+ push @soname_wo_symfile, $soname;
|
|
|
+ add_shlibs_dep($soname, $pkg);
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # Scan all undefined symbols of the binary and resolve to a
|
|
|
+ # dependency
|
|
|
+ my @sonames = $obj->get_needed_libraries;
|
|
|
+ my %used_sonames = map { $_ => 0 } @sonames;
|
|
|
+ foreach my $sym ($obj->get_undefined_dynamic_symbols()) {
|
|
|
+ my $name = $sym->{name};
|
|
|
+ if ($sym->{version}) {
|
|
|
+ $name .= "\@$sym->{version}";
|
|
|
+ } else {
|
|
|
+ $name .= "\@Base";
|
|
|
+ }
|
|
|
+ my $symdep = $symfile->lookup_symbol($name, \@sonames);
|
|
|
+ if (defined($symdep)) {
|
|
|
+ my ($d, $m) = ($symdep->{depends}, $symdep->{minver});
|
|
|
+ $used_sonames{$symdep->{soname}}++;
|
|
|
+ foreach my $subdep (split /\s*,\s*/, $d) {
|
|
|
+ if (exists $dependencies{$cur_field}{$subdep} and
|
|
|
+ defined($dependencies{$cur_field}{$subdep}))
|
|
|
+ {
|
|
|
+ if ($dependencies{$cur_field}{$subdep} eq '' or
|
|
|
+ compare_versions($m, "gt", $dependencies{$cur_field}{$subdep}))
|
|
|
+ {
|
|
|
+ $dependencies{$cur_field}{$subdep} = $m;
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ $dependencies{$cur_field}{$subdep} = $m;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ my $syminfo = $dumplibs_wo_symfile->locate_symbol($name);
|
|
|
+ if (not defined($syminfo)) {
|
|
|
+ my $print_name = $name;
|
|
|
+ $print_name =~ s/\@Base$//; # Drop the default suffix for readability
|
|
|
+ warning(sprintf(
|
|
|
+ _g("symbol %s used by %s found in none of the libraries."),
|
|
|
+ $print_name, $file)) unless $sym->{weak};
|
|
|
+ } else {
|
|
|
+ $used_sonames{$syminfo->{soname}}++;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ # Warn about un-NEEDED libraries
|
|
|
+ foreach my $soname (@sonames) {
|
|
|
+ unless ($used_sonames{$soname}) {
|
|
|
+ warning(sprintf(
|
|
|
+ _g("%s shouldn't be linked with %s (it uses none of its symbols)."),
|
|
|
+ $file, $soname));
|
|
|
+ }
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+# Open substvars file
|
|
|
+my $fh;
|
|
|
+if ($stdout) {
|
|
|
+ $fh = \*STDOUT;
|
|
|
+} else {
|
|
|
+ open(NEW,"> $varlistfile.new") ||
|
|
|
+ syserr(sprintf(_g("open new substvars file \`%s'"), "$varlistfile.new"));
|
|
|
+ if (-e $varlistfile) {
|
|
|
+ open(OLD,"< $varlistfile") ||
|
|
|
+ syserr(sprintf(_g("open old varlist file \`%s' for reading"), $varlistfile));
|
|
|
+ foreach my $entry (grep { not /^\Q$varnameprefix\E:/ } (<OLD>)) {
|
|
|
+ print(NEW $entry) ||
|
|
|
+ syserr(sprintf(_g("copy old entry to new varlist file \`%s'"), "$varlistfile.new"));
|
|
|
+ }
|
|
|
+ }
|
|
|
+ $fh = \*NEW;
|
|
|
+}
|
|
|
+
|
|
|
+# Write out the shlibs substvars
|
|
|
+my %depseen;
|
|
|
+foreach my $field (reverse @depfields) {
|
|
|
+ my $dep = "";
|
|
|
+ if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) {
|
|
|
+ $dep = join ", ",
|
|
|
+ map {
|
|
|
+ # Translate dependency templates into real dependencies
|
|
|
+ if ($dependencies{$field}{$_}) {
|
|
|
+ s/#MINVER#/(>= $dependencies{$field}{$_})/g;
|
|
|
+ } else {
|
|
|
+ s/#MINVER#//g;
|
|
|
+ }
|
|
|
+ s/\s+/ /g;
|
|
|
+ $_;
|
|
|
+ } grep {
|
|
|
+ # Don't include dependencies if they are already
|
|
|
+ # mentionned in a higher priority field
|
|
|
+ if (not defined($depseen{$_})) {
|
|
|
+ $depseen{$_} = $dependencies{$field}{$_};
|
|
|
+ 1;
|
|
|
+ } else {
|
|
|
+ # Since dependencies can be versionned, we have to
|
|
|
+ # verify if the dependency is stronger than the
|
|
|
+ # previously seen one
|
|
|
+ if (compare_versions($depseen{$_}, "gt",
|
|
|
+ $dependencies{$field}{$_})) {
|
|
|
+ 0;
|
|
|
+ } else {
|
|
|
+ $depseen{$_} = $dependencies{$field}{$_};
|
|
|
+ 1;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ } keys %{$dependencies{$field}};
|
|
|
+ }
|
|
|
+ if ($dep) {
|
|
|
+ print $fh "$varnameprefix:$field=$dep\n";
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+# Replace old file by new one
|
|
|
+if (!$stdout) {
|
|
|
+ close($fh);
|
|
|
+ rename("$varlistfile.new",$varlistfile) ||
|
|
|
+ syserr(sprintf(_g("install new varlist file \`%s'"), $varlistfile));
|
|
|
+}
|
|
|
+
|
|
|
+##
|
|
|
+## Functions
|
|
|
+##
|
|
|
|
|
|
sub version {
|
|
|
printf _g("Debian %s version %s.\n"), $progname, $version;
|
|
|
@@ -43,7 +272,9 @@ sub version {
|
|
|
printf _g("
|
|
|
Copyright (C) 1996 Ian Jackson.
|
|
|
Copyright (C) 2000 Wichert Akkerman.
|
|
|
-Copyright (C) 2006 Frank Lichtenheld.");
|
|
|
+Copyright (C) 2006 Frank Lichtenheld.
|
|
|
+Copyright (C) 2007 Raphael Hertzog.
|
|
|
+");
|
|
|
|
|
|
printf _g("
|
|
|
This is free software; see the GNU General Public Licence version 2 or
|
|
|
@@ -75,376 +306,117 @@ Dependency fields recognised are:
|
|
|
"), $progname, join("/",@depfields);
|
|
|
}
|
|
|
|
|
|
-my ($stdout, @exec, @execfield);
|
|
|
-foreach (@ARGV) {
|
|
|
- if (m/^-T/) {
|
|
|
- $varlistfile= $POSTMATCH;
|
|
|
- } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) {
|
|
|
- $varnameprefix= $1;
|
|
|
- } elsif (m/^-L/) {
|
|
|
- $shlibslocal= $POSTMATCH;
|
|
|
- } elsif (m/^-O$/) {
|
|
|
- $stdout= 1;
|
|
|
- } elsif (m/^-(h|-help)$/) {
|
|
|
- usage; exit(0);
|
|
|
- } elsif (m/^--version$/) {
|
|
|
- version; exit(0);
|
|
|
- } elsif (m/^--admindir=/) {
|
|
|
- $admindir = $POSTMATCH;
|
|
|
- -d $admindir ||
|
|
|
- error(sprintf(_g("administrative directory '%s' does not exist"),
|
|
|
- $admindir));
|
|
|
- } elsif (m/^-d/) {
|
|
|
- $dependencyfield= capit($POSTMATCH);
|
|
|
- defined($depstrength{$dependencyfield}) ||
|
|
|
- warning(sprintf(_g("unrecognised dependency field '%s'"), $dependencyfield));
|
|
|
- } elsif (m/^-e/) {
|
|
|
- push(@exec,$POSTMATCH); push(@execfield,$dependencyfield);
|
|
|
- } elsif (m/^-t/) {
|
|
|
- $packagetype= $POSTMATCH;
|
|
|
- } elsif (m/^-/) {
|
|
|
- usageerr(sprintf(_g("unknown option \`%s'"), $_));
|
|
|
- } else {
|
|
|
- push(@exec,$_); push(@execfield,$dependencyfield);
|
|
|
+sub add_shlibs_dep {
|
|
|
+ my ($soname, $pkg) = @_;
|
|
|
+ foreach my $file ($shlibslocal, $shlibsoverride, @pkg_shlibs,
|
|
|
+ "$admindir/info/$pkg.shlibs")
|
|
|
+ {
|
|
|
+ next if not -e $file;
|
|
|
+ my $dep = extract_from_shlibs($soname, $file);
|
|
|
+ if (defined($dep)) {
|
|
|
+ foreach (split(/,\s*/, $dep)) {
|
|
|
+ $dependencies{$cur_field}{$_} = 1;
|
|
|
+ }
|
|
|
+ last;
|
|
|
+ }
|
|
|
}
|
|
|
}
|
|
|
|
|
|
-$shlibsppdir = "$admindir/info";
|
|
|
-
|
|
|
-@exec || usageerr(_g("need at least one executable"));
|
|
|
-
|
|
|
-sub isbin {
|
|
|
- open (F, $_[0]) || die(sprintf(_g("unable to open '%s' for test"), $_[0]));
|
|
|
- my $d;
|
|
|
- if (read (F, $d, 4) != 4) {
|
|
|
- die (sprintf(_g("unable to read first four bytes of '%s' as magic number"), $_[0]));
|
|
|
- }
|
|
|
- if ($d =~ /^\177ELF$/) { # ELF binary
|
|
|
- return 1;
|
|
|
- } elsif (unpack ('N', $d) == 0x8086010B) { # obsd dyn bin
|
|
|
- return 1;
|
|
|
- } elsif (unpack ('N', $d) == 0x86010B) { # obsd stat bin
|
|
|
- return 1;
|
|
|
- } elsif ($d =~ /^\#\!..$/) { # shell script
|
|
|
- return 0;
|
|
|
- } elsif (unpack ('N', $d) == 0xcafebabe) { # JAVA binary
|
|
|
- return 0;
|
|
|
+sub extract_from_shlibs {
|
|
|
+ my ($soname, $shlibfile) = @_;
|
|
|
+ my ($libname, $libversion);
|
|
|
+ # Split soname in name/version
|
|
|
+ if ($soname =~ /^(.*)\.so\.(.*)$/) {
|
|
|
+ $libname = $1; $libversion = $2;
|
|
|
+ } elsif ($soname =~ /^(.*)-(.*)\.so$/) {
|
|
|
+ $libname = $1; $libversion = $2;
|
|
|
} else {
|
|
|
- die(sprintf(_g("unrecognized file type for '%s'"), $_[0]));
|
|
|
- }
|
|
|
-}
|
|
|
-
|
|
|
-my @librarypaths = qw( /lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
|
|
|
- /emul/ia32-linux/lib /emul/ia32-linux/usr/lib );
|
|
|
-my %librarypaths = map { $_ => 'default' } @librarypaths;
|
|
|
-
|
|
|
-if ($ENV{LD_LIBRARY_PATH}) {
|
|
|
- foreach (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) {
|
|
|
- s,/+$,,;
|
|
|
- unless (exists $librarypaths{$_}) {
|
|
|
- $librarypaths{$_} = 'env';
|
|
|
- unshift @librarypaths, $_;
|
|
|
- }
|
|
|
+ warning(sprintf(_g("Can't extract name and version from library name \`%s'"), $soname));
|
|
|
+ return;
|
|
|
}
|
|
|
-}
|
|
|
-
|
|
|
-# Support system library directories.
|
|
|
-my $ldconfigdir = '/lib/ldconfig';
|
|
|
-if (opendir(DIR, $ldconfigdir)) {
|
|
|
- my @dirents = readdir(DIR);
|
|
|
- closedir(DIR);
|
|
|
-
|
|
|
- for (@dirents) {
|
|
|
- next if /^\./;
|
|
|
- my $d = `readlink -f $ldconfigdir/$_`;
|
|
|
- chomp $d;
|
|
|
- unless (exists $librarypaths{$d}) {
|
|
|
- $librarypaths{$d} = 'ldconfig';
|
|
|
- push @librarypaths, $d;
|
|
|
+ # Open shlibs file
|
|
|
+ $shlibfile = "./$shlibfile" if $shlibfile =~ m/^\s/;
|
|
|
+ open(SHLIBS, "< $shlibfile") || syserr(sprintf(_g("unable to open shared libs info file \`%s'"), $shlibfile));
|
|
|
+ my $dep;
|
|
|
+ while (<SHLIBS>) {
|
|
|
+ s/\s*\n$//; next if m/^\#/;
|
|
|
+ if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)\s+(\S.*\S)\s*$/) {
|
|
|
+ warning(sprintf(_g("shared libs info file \`%s' line %d: bad line \`%s'"), $shlibfile, $., $_));
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ my $type = defined($1) ? $1 : "deb";
|
|
|
+ next if $type ne $packagetype;
|
|
|
+ if (($libname eq $2) && ($libversion eq $3)) {
|
|
|
+ $dep = $4;
|
|
|
+ last;
|
|
|
}
|
|
|
}
|
|
|
+ close(SHLIBS);
|
|
|
+ return $dep;
|
|
|
}
|
|
|
|
|
|
-open CONF, '</etc/ld.so.conf' or
|
|
|
- warning(sprintf(_g("couldn't open /etc/ld.so.conf: %s"), $!));
|
|
|
-while( <CONF> ) {
|
|
|
- next if /^\s*$/;
|
|
|
- chomp;
|
|
|
- s,/+$,,;
|
|
|
- unless (exists $librarypaths{$_}) {
|
|
|
- $librarypaths{$_} = 'conf';
|
|
|
- push @librarypaths, $_;
|
|
|
- }
|
|
|
-}
|
|
|
-close CONF;
|
|
|
-
|
|
|
-my (%rpaths, %format);
|
|
|
-my (@libfiles, @libname, @libsoname, @libfield, @libexec);
|
|
|
-for ($i=0;$i<=$#exec;$i++) {
|
|
|
- if (!isbin ($exec[$i])) { next; }
|
|
|
-
|
|
|
- # Now we get the direct deps of the program
|
|
|
- defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for objdump"));
|
|
|
- if (!$c) {
|
|
|
- exec("objdump", "-p", "--", $exec[$i]) or
|
|
|
- syserr(_g("cannot exec objdump"));
|
|
|
- }
|
|
|
- while (<P>) {
|
|
|
- chomp;
|
|
|
- if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
|
|
|
- $format{$exec[$i]} = $1;
|
|
|
- } elsif (m,^\s*NEEDED\s+,) {
|
|
|
- if (m,^\s*NEEDED\s+((\S+)\.so\.(\S+))$,) {
|
|
|
- push(@libname,$2); push(@libsoname,$3);
|
|
|
- push(@libfield,$execfield[$i]);
|
|
|
- push(@libfiles,$1);
|
|
|
- push(@libexec,$exec[$i]);
|
|
|
- } elsif (m,^\s*NEEDED\s+((\S+)-(\S+)\.so)$,) {
|
|
|
- push(@libname,$2); push(@libsoname,$3);
|
|
|
- push(@libfield,$execfield[$i]);
|
|
|
- push(@libfiles,$1);
|
|
|
- push(@libexec,$exec[$i]);
|
|
|
- } else {
|
|
|
- m,^\s*NEEDED\s+(\S+)$,;
|
|
|
- warning(sprintf(_g("format of 'NEEDED %s' not recognized"), $1));
|
|
|
- }
|
|
|
- } elsif (/^\s*RPATH\s+(\S+)\s*$/) {
|
|
|
- push @{$rpaths{$exec[$i]}}, split(/:/, $1);
|
|
|
+sub find_symbols_file {
|
|
|
+ my ($pkg, $soname) = @_;
|
|
|
+ foreach my $file (@pkg_symbols,
|
|
|
+ "/etc/dpkg/symbols/$pkg.symbols.$host_arch",
|
|
|
+ "/etc/dpkg/symbols/$pkg.symbols",
|
|
|
+ "$admindir/info/$pkg.symbols")
|
|
|
+ {
|
|
|
+ if (-e $file and symfile_has_soname($file, $soname)) {
|
|
|
+ return $file;
|
|
|
}
|
|
|
}
|
|
|
- close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $exec[$i]));
|
|
|
+ return undef;
|
|
|
}
|
|
|
|
|
|
-# Now: See if it is in this package. See if it is in any other package.
|
|
|
-my @curshlibs;
|
|
|
-sub searchdir {
|
|
|
- my $dir = shift;
|
|
|
- if(opendir(DIR, $dir)) {
|
|
|
- my @dirents = readdir(DIR);
|
|
|
- closedir(DIR);
|
|
|
- for (@dirents) {
|
|
|
- if ( -f "$dir/$_/DEBIAN/shlibs" ) {
|
|
|
- push(@curshlibs, "$dir/$_/DEBIAN/shlibs");
|
|
|
- next;
|
|
|
- } elsif ( $_ !~ /^\./ && ! -e "$dir/$_/DEBIAN" &&
|
|
|
- -d "$dir/$_" && ! -l "$dir/$_" ) {
|
|
|
- &searchdir("$dir/$_");
|
|
|
- }
|
|
|
+sub symfile_has_soname {
|
|
|
+ my ($file, $soname) = @_;
|
|
|
+ open(SYM_FILE, "< $file") || syserr("can't open file $file");
|
|
|
+ my $result = 0;
|
|
|
+ while (<SYM_FILE>) {
|
|
|
+ if (/^\Q$soname\E /) {
|
|
|
+ $result = 1;
|
|
|
+ last;
|
|
|
}
|
|
|
}
|
|
|
+ close(SYM_FILE);
|
|
|
+ return $result;
|
|
|
}
|
|
|
|
|
|
-my $searchdir = $exec[0];
|
|
|
-my $curpackdir = "debian/tmp";
|
|
|
-do { $searchdir =~ s,/[^/]*$,,; } while($searchdir =~ m,/,
|
|
|
- && ! -d "$searchdir/DEBIAN");
|
|
|
-if ($searchdir =~ m,/,) {
|
|
|
- $curpackdir = $searchdir;
|
|
|
- $searchdir =~ s,/[^/]*,,;
|
|
|
- &searchdir($searchdir);
|
|
|
-}
|
|
|
-
|
|
|
-if (1 || $#curshlibs >= 0) {
|
|
|
- PRELIB:
|
|
|
- for ($i=0;$i<=$#libname;$i++) {
|
|
|
- if(scanshlibsfile($shlibslocal,$libname[$i],$libsoname[$i],$libfield[$i])
|
|
|
- || scanshlibsfile($shlibsoverride,$libname[$i],$libsoname[$i],$libfield[$i])) {
|
|
|
- splice(@libname, $i, 1);
|
|
|
- splice(@libsoname, $i, 1);
|
|
|
- splice(@libfield, $i, 1);
|
|
|
- splice(@libfiles, $i, 1);
|
|
|
- splice(@libexec, $i, 1);
|
|
|
- $i--;
|
|
|
- next PRELIB;
|
|
|
- }
|
|
|
- for my $shlibsfile (@curshlibs) {
|
|
|
- if(scanshlibsfile($shlibsfile, $libname[$i], $libsoname[$i], $libfield[$i])) {
|
|
|
- splice(@libname, $i, 1);
|
|
|
- splice(@libsoname, $i, 1);
|
|
|
- splice(@libfield, $i, 1);
|
|
|
- splice(@libfiles, $i, 1);
|
|
|
- splice(@libexec, $i, 1);
|
|
|
- $i--;
|
|
|
- next PRELIB;
|
|
|
- }
|
|
|
- }
|
|
|
+# find_library ($soname, \@rpath, $format)
|
|
|
+sub my_find_library {
|
|
|
+ my ($lib, $rpath, $format) = @_;
|
|
|
+ my $file = find_library($lib, $rpath, $format, "");
|
|
|
+ return $file if defined($file);
|
|
|
+
|
|
|
+ # Look into the packages we're currently building (but only those
|
|
|
+ # that provides shlibs file...)
|
|
|
+ # TODO: we should probably replace that by a cleaner way to look into
|
|
|
+ # the various temporary build directories...
|
|
|
+ foreach my $builddir (map { s{/DEBIAN/shlibs$}{}; $_ } @pkg_shlibs) {
|
|
|
+ $file = find_library($lib, $rpath, $format, $builddir);
|
|
|
+ return $file if defined($file);
|
|
|
}
|
|
|
+ return undef;
|
|
|
}
|
|
|
|
|
|
-my %pathpackages;
|
|
|
-if ($#libfiles >= 0) {
|
|
|
- grep(s/\[\?\*/\\$&/g, @libname);
|
|
|
- defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for dpkg --search"));
|
|
|
- if (!$c) {
|
|
|
- my %seen_libfiles;
|
|
|
- my @uniq_libfiles = grep !$seen_libfiles{$_}++, @libfiles;
|
|
|
-
|
|
|
- close STDERR; # we don't need to see dpkg's errors
|
|
|
- open STDERR, "> /dev/null";
|
|
|
- $ENV{LC_ALL} = "C";
|
|
|
- exec("dpkg", "--search", "--", @uniq_libfiles) or
|
|
|
- syserr(_g("cannot exec dpkg"));
|
|
|
- }
|
|
|
- while (<P>) {
|
|
|
- chomp;
|
|
|
+sub find_packages {
|
|
|
+ my @files = (@_);
|
|
|
+ my $pkgmatch = {};
|
|
|
+ open(DPKG, "dpkg --search -- @files 2>/dev/null |") ||
|
|
|
+ syserr(sprintf(_g("Can't execute dpkg --search: %s"), $!));
|
|
|
+ while(defined($_ = <DPKG>)) {
|
|
|
+ chomp($_);
|
|
|
if (m/^local diversion |^diversion by/) {
|
|
|
warning(_g("diversions involved - output may be incorrect"));
|
|
|
print(STDERR " $_\n") || syserr(_g("write diversion info to stderr"));
|
|
|
- } elsif (m=^(\S+(, \S+)*): (\S+)$=) {
|
|
|
- push @{$pathpackages{$LAST_PAREN_MATCH}}, split(/, /, $1);
|
|
|
+ } elsif (m/^([^:]+): (\S+)$/) {
|
|
|
+ $pkgmatch->{$2} = [ split(/, /, $1) ];
|
|
|
} else {
|
|
|
warning(sprintf(_g("unknown output from dpkg --search: '%s'"), $_));
|
|
|
}
|
|
|
}
|
|
|
- close(P);
|
|
|
+ close(DPKG);
|
|
|
+ return $pkgmatch;
|
|
|
}
|
|
|
|
|
|
- LIB:
|
|
|
- for ($i=0;$i<=$#libname;$i++) {
|
|
|
- my $file = $libfiles[$i];
|
|
|
- my @packages;
|
|
|
- foreach my $rpath (@{$rpaths{$libexec[$i]}}) {
|
|
|
- if (exists $pathpackages{"$rpath/$file"}
|
|
|
- && format_matches($libexec[$i],"$rpath/$file")) {
|
|
|
- push @packages, @{$pathpackages{"$rpath/$file"}};
|
|
|
- }
|
|
|
- }
|
|
|
- foreach my $path (@librarypaths) {
|
|
|
- if (exists $pathpackages{"$path/$file"}
|
|
|
- && format_matches($libexec[$i],"$path/$file")) {
|
|
|
- push @packages, @{$pathpackages{"$path/$file"}};
|
|
|
- }
|
|
|
- }
|
|
|
- if (!@packages) {
|
|
|
- warning(sprintf(_g("could not find any packages for %s"), $libfiles[$i]));
|
|
|
- } else {
|
|
|
- for my $p (@packages) {
|
|
|
- scanshlibsfile("$shlibsppdir/$p$shlibsppext",
|
|
|
- $libname[$i],$libsoname[$i],$libfield[$i])
|
|
|
- && next LIB;
|
|
|
- }
|
|
|
- }
|
|
|
- scanshlibsfile($shlibsdefault,$libname[$i],$libsoname[$i],$libfield[$i])
|
|
|
- && next;
|
|
|
- warning(sprintf(_g("unable to find dependency information for ".
|
|
|
- "shared library %s (soname %s, ".
|
|
|
- "path %s, dependency field %s)"),
|
|
|
- $libname[$i], $libsoname[$i],
|
|
|
- $libfiles[$i], $libfield[$i]));
|
|
|
- }
|
|
|
-
|
|
|
-sub format_matches {
|
|
|
- my ($file1, $file2) = @_;
|
|
|
- my ($format1, $format2) = (get_format($file1),get_format($file2));
|
|
|
- return $format1 eq $format2;
|
|
|
-}
|
|
|
-
|
|
|
-sub get_format {
|
|
|
- my ($file) = @_;
|
|
|
-
|
|
|
- if ($format{$file}) {
|
|
|
- return $format{$file};
|
|
|
- } else {
|
|
|
- defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for objdump"));
|
|
|
- if (!$c) {
|
|
|
- exec("objdump", "-a", "--", $file) or
|
|
|
- syserr(_g("cannot exec objdump"));
|
|
|
- }
|
|
|
- while (<P>) {
|
|
|
- chomp;
|
|
|
- if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
|
|
|
- $format{$file} = $1;
|
|
|
- return $format{$file};
|
|
|
- }
|
|
|
- }
|
|
|
- close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $file));
|
|
|
- }
|
|
|
-}
|
|
|
-
|
|
|
-my (%predefdepfdep, %unkdepfdone, %unkdepf);
|
|
|
-sub scanshlibsfile {
|
|
|
- my ($fn,$ln,$lsn,$lf) = @_;
|
|
|
- my ($da,$dk);
|
|
|
- $fn= "./$fn" if $fn =~ m/^\s/;
|
|
|
- if (!open(SLF,"< $fn")) {
|
|
|
- $! == ENOENT || syserr(sprintf(_g("unable to open shared libs info file \`%s'"), $fn));
|
|
|
- return 0;
|
|
|
- }
|
|
|
-
|
|
|
- while (<SLF>) {
|
|
|
- s/\s*\n$//; next if m/^\#/;
|
|
|
- if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)/) {
|
|
|
- warning(sprintf(_g("shared libs info file '%s' line %d: bad line '%s'"), $fn, $., $_));
|
|
|
- next;
|
|
|
- }
|
|
|
- next if defined $1 && $1 ne $packagetype;
|
|
|
- next if $2 ne $ln || $3 ne $lsn;
|
|
|
- return 1 if $fn eq "$curpackdir/DEBIAN/shlibs";
|
|
|
- $da= $POSTMATCH;
|
|
|
- last if defined $1; # exact match, otherwise keep looking
|
|
|
- }
|
|
|
- close(SLF);
|
|
|
-
|
|
|
- return 0 unless defined $da;
|
|
|
-
|
|
|
- for my $dv (split(/,/,$da)) {
|
|
|
- $dv =~ s/^\s+//; $dv =~ s/\s+$//;
|
|
|
- if (defined($depstrength{$lf})) {
|
|
|
- if (!defined($predefdepfdep{$dv}) ||
|
|
|
- $depstrength{$predefdepfdep{$dv}} < $depstrength{$lf}) {
|
|
|
- $predefdepfdep{$dv}= $lf;
|
|
|
- }
|
|
|
- } else {
|
|
|
- $dk= "$lf: $dv";
|
|
|
- if (!defined($unkdepfdone{$dk})) {
|
|
|
- $unkdepfdone{$dk}= 1;
|
|
|
- $unkdepf{$lf} .= ', ' if defined($unkdepf{$lf});
|
|
|
- $unkdepf{$lf}.= $dv;
|
|
|
- }
|
|
|
- }
|
|
|
- }
|
|
|
- return 1;
|
|
|
-}
|
|
|
-
|
|
|
-my $fh;
|
|
|
-if (!$stdout) {
|
|
|
- open(Y,"> $varlistfile.new") ||
|
|
|
- syserr(sprintf(_g("open new substvars file \`%s'"), "$varlistfile.new"));
|
|
|
- unless ($REAL_USER_ID) {
|
|
|
- chown(getfowner(), "$varlistfile.new") ||
|
|
|
- syserr(sprintf(_g("chown of \`%s'"), "$varlistfile.new"));
|
|
|
- }
|
|
|
- if (open(X,"< $varlistfile")) {
|
|
|
- while (<X>) {
|
|
|
- s/\n$//;
|
|
|
- next if m/^(\w[-:0-9A-Za-z]*):/ && $1 eq $varnameprefix;
|
|
|
- print(Y "$_\n") ||
|
|
|
- syserr(sprintf(_g("copy old entry to new varlist file \`%s'"), "$varlistfile.new"));
|
|
|
- }
|
|
|
- } elsif ($! != ENOENT) {
|
|
|
- syserr(sprintf(_g("open old varlist file \`%s' for reading"), $varlistfile));
|
|
|
- }
|
|
|
- $fh = \*Y;
|
|
|
-} else {
|
|
|
- $fh = \*STDOUT;
|
|
|
-}
|
|
|
-my %defdepf;
|
|
|
-for my $dv (sort keys %predefdepfdep) {
|
|
|
- my $lf= $predefdepfdep{$dv};
|
|
|
- $defdepf{$lf} .= ', ' if defined($defdepf{$lf});
|
|
|
- $defdepf{$lf}.= $dv;
|
|
|
-}
|
|
|
-for my $lf (reverse @depfields) {
|
|
|
- next unless defined($defdepf{$lf});
|
|
|
- print($fh "$varnameprefix:$lf=$defdepf{$lf}\n")
|
|
|
- || syserr(_g("write output entry"));
|
|
|
-}
|
|
|
-for my $lf (sort keys %unkdepf) {
|
|
|
- print($fh "$varnameprefix:$lf=$unkdepf{$lf}\n")
|
|
|
- || syserr(_g("write userdef output entry"));
|
|
|
-}
|
|
|
-close($fh) || syserr(_g("close output"));
|
|
|
-if (!$stdout) {
|
|
|
- rename("$varlistfile.new",$varlistfile) ||
|
|
|
- syserr(sprintf(_g("install new varlist file \`%s'"), $varlistfile));
|
|
|
-}
|
Frank Lichtenheld