[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

Bug#317082: Not just a dpkg bug

tags 317082 patch
tags 317082 - moreinfo
thanks

On Fri, Jan 20, 2006 at 03:47:35AM -0800, Steve Langasek wrote:
> On Thu, Jan 19, 2006 at 12:14:35AM +0100, Frank Lichtenheld wrote:
> > 1) use "dpkg --search" but only with the library name from objdump, not
> >    with the full path.
> >    Questions: - Are there cases where the library name from objdump isn't
> >                 actually the filename of the library?
> > 	      - How do we decide wether a found file is really a usable
> > 	        library? (parse /etc/ld.so.conf?)
> 
[...]
> The only requirement is that dpkg have an internal representation of the
> library search path for the object type -- part of which comes from
> /etc/ld.so.conf, part of which is hard-coded in ld.so.  Oh... and then
> there's RPATH...

I've implemented this option. Patch and new script (since the patch is
garbled with a little code clean-up I did while going through the
script) are attached. 

Comments and/or testing welcome.

Gruesse,
-- 
Frank Lichtenheld <djpig@debian.org>
www: http://www.djpig.de/

--- dpkg-shlibdeps.pl.old	2006-01-22 20:12:09.000000000 +0100
+++ dpkg-shlibdeps.pl	2006-01-22 21:51:59.000000000 +0100
@@ -3,32 +3,38 @@
 # dpkg-shlibdeps
 # $Id: dpkg-shlibdeps.pl,v 1.19.2.2 2004/04/25 17:11:41 keybuk Exp $
 
-$dpkglibdir="/usr/lib/dpkg";
-$version="1.4.1.19"; # This line modified by Makefile
+my $dpkglibdir="/usr/lib/dpkg";
+my $version="1.4.1.19"; # This line modified by Makefile
 
-use POSIX;
+use English;
 use POSIX qw(:errno_h :signal_h);
 
-$shlibsoverride= '/etc/dpkg/shlibs.override';
-$shlibsdefault= '/etc/dpkg/shlibs.default';
-$shlibslocal= 'debian/shlibs.local';
-$shlibsppdir= '/var/lib/dpkg/info';
-$shlibsppext= '.shlibs';
-$varnameprefix= 'shlibs';
-$dependencyfield= 'Depends';
-$varlistfile= 'debian/substvars';
-$packagetype= 'deb';
-
-@depfields= qw(Suggests Recommends Depends Pre-Depends);
+my $shlibsoverride= '/etc/dpkg/shlibs.override';
+my $shlibsdefault= '/etc/dpkg/shlibs.default';
+my $shlibslocal= 'debian/shlibs.local';
+my $shlibsppdir= '/var/lib/dpkg/info';
+my $shlibsppext= '.shlibs';
+my $varnameprefix= 'shlibs';
+my $dependencyfield= 'Depends';
+my $varlistfile= 'debian/substvars';
+my $packagetype= 'deb';
+
+my @depfields= qw(Suggests Recommends Depends Pre-Depends);
+my %depstrength;
+my $i=0; grep($depstrength{$_}= ++$i, @depfields);
 
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+#use strict;
+#use warnings;
+
 sub usageversion {
     print STDERR
 "Debian dpkg-shlibdeps $version.
 Copyright (C) 1996 Ian Jackson.
 Copyright (C) 2000 Wichert Akkerman.
+Copyright (C) 2006 Frank Lichtenheld.
 This is free software; see the GNU General Public Licence version 2 or
 later for copying conditions.  There is NO warranty.
 
@@ -48,28 +54,26 @@
 ";
 }
 
-$i=0; grep($depstrength{$_}= ++$i, @depfields);
-
-while (@ARGV) {
-    $_=shift(@ARGV);
+my ($stdout, @exec, @execf);
+foreach (@ARGV) {
     if (m/^-T/) {
-        $varlistfile= $';
+	$varlistfile= $POSTMATCH;
     } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) {
         $varnameprefix= $1;
     } elsif (m/^-L/) {
-        $shlibslocal= $';
+	$shlibslocal= $POSTMATCH;
     } elsif (m/^-O$/) {
         $stdout= 1;
     } elsif (m/^-h$/) {
         usageversion; exit(0);
     } elsif (m/^-d/) {
-        $dependencyfield= capit($');
+	$dependencyfield= capit($POSTMATCH);
         defined($depstrength{$dependencyfield}) ||
             &warn("unrecognised dependency field \`$dependencyfield'");
     } elsif (m/^-e/) {
-        push(@exec,$'); push(@execf,$dependencyfield);
+	push(@exec,$POSTMATCH); push(@execf,$dependencyfield);
     } elsif (m/^-t/) {
-        $packagetype= $';
+	$packagetype= $POSTMATCH;
     } elsif (m/^-/) {
         usageerr("unknown option \`$_'");
     } else {
@@ -81,14 +85,15 @@
 
 sub isbin {
     open (F, $_[0]) || die("unable to open '$_[0]' for test");
+    my $d;
     if (read (F, $d, 4) != 4) {
        die ("unable to read first four bytes of '$_[0]' as magic number");
     }
     if ($d =~ /^\177ELF$/) { # ELF binary
        return 1;
-    } elsif (unpack ('N', $d) == 2156265739) { # obsd dyn bin
+    } elsif (unpack ('N', $d) == 0x8086010B) { # obsd dyn bin
        return 1;
-    } elsif (unpack ('N', $d) == 8782091) { # obsd stat bin
+    } elsif (unpack ('N', $d) ==   0x86010B) { # obsd stat bin
        return 1;
     } elsif ($d =~ /^\#\!..$/) { # shell script
        return 0;
@@ -99,48 +104,56 @@
     }
 }
 
+my @librarypaths = qw( /lib /usr/lib /lib64 /usr/lib64 );
+my %librarypaths = map { $_ => 1 } @librarypaths;
+open CONF, '</etc/ld.so.conf' or
+    warn( "couldn't open /etc/ld.so.conf: $!" );
+while( <CONF> ) {
+    chomp;
+    next if /^\s*$/;
+    unless ($librarypaths{$_}++) {
+	push @librarypaths, $_;
+    }
+}
+close CONF;
+
+my (%rpaths, %format);
+my (@libfiles, @libname, @libsoname, @libf);
 for ($i=0;$i<=$#exec;$i++) {
     if (!isbin ($exec[$i])) { next; }
     
-    # First we get an ldd output to see what libs + paths we have at out
-    # disposal.
-    my %so2path = ();
-    defined($c= open(P,"-|")) || syserr("cannot fork for ldd");
-    if (!$c) { exec("ldd","--",$exec[$i]); syserr("cannot exec ldd"); }
-    while (<P>) {
-	if (m,^\s+(\S+)\s+=>\s+(\S+)\s+\(0x.+\)?$,) {
-	    $so2path{$1} = $2;
-	}
+    # Now we get the direct deps of the program
+    defined(my $c= open(P,"-|")) || syserr("cannot fork for objdump");
+    if (!$c) {
+	exec("objdump","-p","--",$exec[$i]);
+	syserr("cannot exec objdump");
     }
-    close(P); $? && subprocerr("ldd on \`$exec[$i]'");
-
-    # Now we get the direct deps of the program. We then check back with
-    # the ldd output from above to see what our path is.
-    defined($c= open(P,"-|")) || syserr("cannot fork for objdump");
-    if (!$c) { exec("objdump","-p","--",$exec[$i]); syserr("cannot exec objdump"); }
     while (<P>) {
 	chomp;
-	if (m,^\s*NEEDED\s+,) {
+	if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
+	    $format{$execf[$i]} = $1;
+	} elsif (m,^\s*NEEDED\s+,) {
 	    if (m,^\s*NEEDED\s+((\S+)\.so\.(\S+))$,) {
 		push(@libname,$2); push(@libsoname,$3);
 		push(@libf,$execf[$i]);
-		&warn("could not find path for $1") unless defined($so2path{$1});
-		push(@libfiles,$so2path{$1});
+		push(@libfiles,$1);
 	    } elsif (m,^\s*NEEDED\s+((\S+)-(\S+)\.so)$,) {
 		push(@libname,$2); push(@libsoname,$3);
 		push(@libf,$execf[$i]);
-		&warn("could not find path for $1") unless defined($so2path{$1});
-		push(@libfiles,$so2path{$1});
+		push(@libfiles,$1);
 	    } else {
 		m,^\s*NEEDED\s+(\S+)$,;
-		&warn("format of $1 not recognized");
+		&warn("format of \`NEEDED $1' not recognized");
 	    }
+	} elsif (/^\s*RPATH\s+(\S+)\s*$/) {
+	    push @{$rpaths{$execf[$i]}}, $1;
 	}
     }
-    close(P); $? && subprocerr("objdump on \`$exec[$i]'");
+    close(P) or subprocerr("objdump on \`$exec[$i]'");
 }
 
 # 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)) {
@@ -157,9 +170,10 @@
     }
 }
 
-$searchdir = $exec[0];
-$curpackdir = "debian/tmp";
-do { $searchdir =~ s,/[^/]*$,,; } while($searchdir =~ m,/, && ! -d "$searchdir/DEBIAN");
+my $searchdir = $exec[0];
+my $curpackdir = "debian/tmp";
+do { $searchdir =~ s,/[^/]*$,,; } while($searchdir =~ m,/,
+					&& ! -d "$searchdir/DEBIAN");
 if ($searchdir =~ m,/,) {
     $curpackdir = $searchdir;
     $searchdir =~ s,/[^/]*,,;
@@ -167,7 +181,8 @@
 }
 
 if (1 || $#curshlibs >= 0) {
-    PRELIB: for ($i=0;$i<=$#libname;$i++) {
+  PRELIB:
+    for ($i=0;$i<=$#libname;$i++) {
 	if(scanshlibsfile($shlibslocal,$libname[$i],$libsoname[$i],$libf[$i])
 	    || scanshlibsfile($shlibsoverride,$libname[$i],$libsoname[$i],$libf[$i])) {
 	    splice(@libname, $i, 1);
@@ -190,14 +205,17 @@
     }
 }
 
+my %pathpackages;
 if ($#libfiles >= 0) {
+    # what does this line do? -- djpig
     grep(s/\[\?\*/\\$&/g, @libname);
-    defined($c= open(P,"-|")) || syserr("cannot fork for dpkg --search");
+    defined(my $c= open(P,"-|")) || syserr("cannot fork for dpkg --search");
     if (!$c) {
         close STDERR; # we don't need to see dpkg's errors
 	open STDERR, "> /dev/null";
         $ENV{LC_ALL} = "C";
-        exec("dpkg","--search","--",map {"$_"} @libfiles); syserr("cannot exec dpkg");
+	exec("dpkg","--search","--",@libfiles);
+	syserr("cannot exec dpkg");
     }
     while (<P>) {
        chomp;
@@ -205,7 +223,7 @@
            &warn("diversions involved - output may be incorrect");
            print(STDERR " $_\n") || syserr("write diversion info to stderr");
        } elsif (m=^(\S+(, \S+)*): (\S+)$=) {
-           push @{$pathpackages{$+}}, split(/, /, $1);
+	    push @{$pathpackages{$LAST_PAREN_MATCH}}, split(/, /, $1);
        } else {
            &warn("unknown output from dpkg --search: \`$_'");
        }
@@ -213,26 +231,70 @@
     close(P); 
 }
 
-LIB: for ($i=0;$i<=$#libname;$i++) {
-    if (!defined($pathpackages{$libfiles[$i]})) {
-        &warn("could not find any packages for $libfiles[$i]".
-              " ($libname[$i].so.$libsoname[$i])");
+ LIB:
+    for ($i=0;$i<=$#libname;$i++) {
+	my $file = $libfiles[$i];
+	my @packages;
+	foreach my $rpath (@{$rpaths{$libf[$i]}}) {
+	    if (exists $pathpackages{"$rpath/$file"}
+		&& format_matches($libf[$i],"$rpath/$file")) {
+		push @packages, @{$pathpackages{"$rpath/$file"}};
+	    }
+	}
+	foreach my $path (@librarypaths) {
+	    if (exists $pathpackages{"$path/$file"}
+		&& format_matches($libf[$i],"$path/$file")) {
+		push @packages, @{$pathpackages{"$path/$file"}};
+	    }
+	}
+	if (!@packages) {
+	    &warn("could not find any packages for $libfiles[$i]");
     } else {
-        for $p (@{$pathpackages{$libfiles[$i]}}) {
+	    for my $p (@packages) {
             scanshlibsfile("$shlibsppdir/$p$shlibsppext",
                            $libname[$i],$libsoname[$i],$libf[$i])
                 && next LIB;
         }
     }
-    scanshlibsfile($shlibsdefault,$libname[$i],$libsoname[$i],$libf[$i]) && next;
+	scanshlibsfile($shlibsdefault,$libname[$i],$libsoname[$i],$libf[$i])
+	    && next;
     &warn("unable to find dependency information for ".
-          "shared library $libname[$i] (soname $libsoname[$i], path $libfiles[$i], ".
-          "dependency field $libf[$i])");
+	      "shared library $libname[$i] (soname $libsoname[$i], ".
+	      "path $libfiles[$i], dependency field $libf[$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("cannot fork for objdump");
+	if (!$c) {
+	    exec("objdump","-a","--",$file);
+	    syserr("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("objdump on \`$file'");
+    }
 }
 
+my (%predefdepfdep, %unkdepfdone, %unkdepf);
 sub scanshlibsfile {
     my ($fn,$ln,$lsn,$lf) = @_;
-    my ($da,$dv,$dk);
+    my ($da,$dk);
     $fn= "./$fn" if $fn =~ m/^\s/;
     if (!open(SLF,"< $fn")) {
         $! == ENOENT || syserr("unable to open shared libs info file \`$fn'");
@@ -248,14 +310,14 @@
         next if defined $1 && $1 ne $packagetype;
         next if $2 ne $ln || $3 ne $lsn;
         return 1 if $fn eq "$curpackdir/DEBIAN/shlibs";
-        $da= $';
+        $da= $POSTMATCH;
         last if defined $1; # exact match, otherwise keep looking
     }
     close(SLF);
         
     return 0 unless defined $da;
 
-    for $dv (split(/,/,$da)) {
+    for my $dv (split(/,/,$da)) {
         $dv =~ s/^\s+//; $dv =~ s/\s+$//;
         if (defined($depstrength{$lf})) {
             if (!defined($predefdepfdep{$dv}) ||
@@ -274,10 +336,11 @@
     return 1;
 }
 
+my $fh;
 if (!$stdout) {
     open(Y,"> $varlistfile.new") ||
         syserr("open new substvars file \`$varlistfile.new'");
-    unless ($<) {
+    unless ($REAL_USER_ID) {
 	chown(@fowner, "$varlistfile.new") ||
 	    syserr("chown of \`$varlistfile.new'");
     }
@@ -295,17 +358,18 @@
 } else {
     $fh= 'STDOUT';
 }
-for $dv (sort keys %predefdepfdep) {
-    $lf= $predefdepfdep{$dv};
+my %defdepf;
+for my $dv (sort keys %predefdepfdep) {
+    my $lf= $predefdepfdep{$dv};
     $defdepf{$lf}.= ', ' if length($defdepf{$lf});
     $defdepf{$lf}.= $dv;
 }
-for $lf (reverse @depfields) {
+for my $lf (reverse @depfields) {
     next unless defined($defdepf{$lf});
     print($fh "$varnameprefix:$lf=$defdepf{$lf}\n")
         || syserr("write output entry");
 }
-for $lf (sort keys %unkdepf) {
+for my $lf (sort keys %unkdepf) {
     print($fh "$varnameprefix:$lf=$unkdepf{$lf}\n")
         || syserr("write userdef output entry");
 }

#! /usr/bin/perl
#
# dpkg-shlibdeps
# $Id: dpkg-shlibdeps.pl,v 1.19.2.2 2004/04/25 17:11:41 keybuk Exp $

my $dpkglibdir="/usr/lib/dpkg";
my $version="1.4.1.19"; # This line modified by Makefile

use English;
use POSIX qw(:errno_h :signal_h);

my $shlibsoverride= '/etc/dpkg/shlibs.override';
my $shlibsdefault= '/etc/dpkg/shlibs.default';
my $shlibslocal= 'debian/shlibs.local';
my $shlibsppdir= '/var/lib/dpkg/info';
my $shlibsppext= '.shlibs';
my $varnameprefix= 'shlibs';
my $dependencyfield= 'Depends';
my $varlistfile= 'debian/substvars';
my $packagetype= 'deb';

my @depfields= qw(Suggests Recommends Depends Pre-Depends);
my %depstrength;
my $i=0; grep($depstrength{$_}= ++$i, @depfields);

push(@INC,$dpkglibdir);
require 'controllib.pl';

#use strict;
#use warnings;

sub usageversion {
    print STDERR
"Debian dpkg-shlibdeps $version.
Copyright (C) 1996 Ian Jackson.
Copyright (C) 2000 Wichert Akkerman.
Copyright (C) 2006 Frank Lichtenheld.
This is free software; see the GNU General Public Licence version 2 or
later for copying conditions.  There is NO warranty.

Usage:
  dpkg-shlibdeps [<option> ...] <executable>|-e<executable> [<option>] ...
Positional arguments/options (order is significant):
       <executable>           } include dependencies for <executable>
       -e<executable>         }  (use -e if <executable> starts with \`-')
       -d<dependencyfield>    next executable(s) set shlibs:<dependencyfield>
Overall options (have global effect no matter where placed):
       -p<varnameprefix>      set <varnameprefix>:* instead of shlibs:*.
       -O                     print variable settings to stdout
       -L<localshlibsfile>    shlibs override file, not debian/shlibs.local
       -T<varlistfile>        update variables here, not debian/substvars
       -t<type>               set package type (default is deb)
Dependency fields recognised are ".join("/",@depfields)."
";
}

my ($stdout, @exec, @execf);
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$/) {
	usageversion; exit(0);
    } elsif (m/^-d/) {
	$dependencyfield= capit($POSTMATCH);
	defined($depstrength{$dependencyfield}) ||
	    &warn("unrecognised dependency field \`$dependencyfield'");
    } elsif (m/^-e/) {
	push(@exec,$POSTMATCH); push(@execf,$dependencyfield);
    } elsif (m/^-t/) {
	$packagetype= $POSTMATCH;
    } elsif (m/^-/) {
	usageerr("unknown option \`$_'");
    } else {
	push(@exec,$_); push(@execf,$dependencyfield);
    }
}

@exec || usageerr("need at least one executable");

sub isbin {
    open (F, $_[0]) || die("unable to open '$_[0]' for test");
    my $d;
    if (read (F, $d, 4) != 4) {
       die ("unable to read first four bytes of '$_[0]' as magic number");
    }
    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;
    } else {
       die("unrecognized file type for '$_[0]'");
    }
}

my @librarypaths = qw( /lib /usr/lib /lib64 /usr/lib64 );
my %librarypaths = map { $_ => 1 } @librarypaths;
open CONF, '</etc/ld.so.conf' or
    warn( "couldn't open /etc/ld.so.conf: $!" );
while( <CONF> ) {
    chomp;
    next if /^\s*$/;
    unless ($librarypaths{$_}++) {
	push @librarypaths, $_;
    }
}
close CONF;

my (%rpaths, %format);
my (@libfiles, @libname, @libsoname, @libf);
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("cannot fork for objdump");
    if (!$c) {
	exec("objdump","-p","--",$exec[$i]);
	syserr("cannot exec objdump");
    }
    while (<P>) {
	chomp;
	if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
	    $format{$execf[$i]} = $1;
	} elsif (m,^\s*NEEDED\s+,) {
	    if (m,^\s*NEEDED\s+((\S+)\.so\.(\S+))$,) {
		push(@libname,$2); push(@libsoname,$3);
		push(@libf,$execf[$i]);
		push(@libfiles,$1);
	    } elsif (m,^\s*NEEDED\s+((\S+)-(\S+)\.so)$,) {
		push(@libname,$2); push(@libsoname,$3);
		push(@libf,$execf[$i]);
		push(@libfiles,$1);
	    } else {
		m,^\s*NEEDED\s+(\S+)$,;
		&warn("format of \`NEEDED $1' not recognized");
	    }
	} elsif (/^\s*RPATH\s+(\S+)\s*$/) {
	    push @{$rpaths{$execf[$i]}}, $1;
	}
    }
    close(P) or subprocerr("objdump on \`$exec[$i]'");
}

# 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 ( $_ !~ /^\./ && -d "$dir/$_" && ! -l "$dir/$_" ) {
		&searchdir("$dir/$_");
	    }
	}
    }
}

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],$libf[$i])
	   || scanshlibsfile($shlibsoverride,$libname[$i],$libsoname[$i],$libf[$i])) {
	    splice(@libname, $i, 1);
	    splice(@libsoname, $i, 1);
	    splice(@libf, $i, 1);
	    splice(@libfiles, $i, 1);
	    $i--;
	    next PRELIB;
	}
	for my $shlibsfile (@curshlibs) {
	    if(scanshlibsfile($shlibsfile, $libname[$i], $libsoname[$i], $libf[$i])) {
		splice(@libname, $i, 1);
		splice(@libsoname, $i, 1);
		splice(@libf, $i, 1);
		splice(@libfiles, $i, 1);
		$i--;
		next PRELIB;
	    }
	}
    }
}

my %pathpackages;
if ($#libfiles >= 0) {
    # what does this line do? -- djpig
    grep(s/\[\?\*/\\$&/g, @libname);
    defined(my $c= open(P,"-|")) || syserr("cannot fork for dpkg --search");
    if (!$c) {
	close STDERR; # we don't need to see dpkg's errors
	open STDERR, "> /dev/null";
	$ENV{LC_ALL} = "C";
	exec("dpkg","--search","--",@libfiles);
	syserr("cannot exec dpkg");
    }
    while (<P>) {
	chomp;
	if (m/^local diversion |^diversion by/) {
	    &warn("diversions involved - output may be incorrect");
	    print(STDERR " $_\n") || syserr("write diversion info to stderr");
	} elsif (m=^(\S+(, \S+)*): (\S+)$=) {
	    push @{$pathpackages{$LAST_PAREN_MATCH}}, split(/, /, $1);
	} else {
	    &warn("unknown output from dpkg --search: \`$_'");
	}
    }
    close(P);
}

 LIB:
    for ($i=0;$i<=$#libname;$i++) {
	my $file = $libfiles[$i];
	my @packages;
	foreach my $rpath (@{$rpaths{$libf[$i]}}) {
	    if (exists $pathpackages{"$rpath/$file"}
		&& format_matches($libf[$i],"$rpath/$file")) {
		push @packages, @{$pathpackages{"$rpath/$file"}};
	    }
	}
	foreach my $path (@librarypaths) {
	    if (exists $pathpackages{"$path/$file"}
		&& format_matches($libf[$i],"$path/$file")) {
		push @packages, @{$pathpackages{"$path/$file"}};
	    }
	}
	if (!@packages) {
	    &warn("could not find any packages for $libfiles[$i]");
	} else {
	    for my $p (@packages) {
		scanshlibsfile("$shlibsppdir/$p$shlibsppext",
			       $libname[$i],$libsoname[$i],$libf[$i])
		    && next LIB;
	    }
	}
	scanshlibsfile($shlibsdefault,$libname[$i],$libsoname[$i],$libf[$i])
	    && next;
	&warn("unable to find dependency information for ".
	      "shared library $libname[$i] (soname $libsoname[$i], ".
	      "path $libfiles[$i], dependency field $libf[$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("cannot fork for objdump");
	if (!$c) {
	    exec("objdump","-a","--",$file);
	    syserr("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("objdump on \`$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("unable to open shared libs info file \`$fn'");
        return 0;
    }

    while (<SLF>) {
        s/\s*\n$//; next if m/^\#/;
        if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)/) {
            &warn("shared libs info file \`$fn' line $.: bad line \`$_'");
            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 length($unkdepf{$lf});
                $unkdepf{$lf}.= $dv;
            }
        }
    }
    return 1;
}

my $fh;
if (!$stdout) {
    open(Y,"> $varlistfile.new") ||
        syserr("open new substvars file \`$varlistfile.new'");
    unless ($REAL_USER_ID) {
	chown(@fowner, "$varlistfile.new") ||
	    syserr("chown of \`$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("copy old entry to new varlist file \`$varlistfile.new'");
        }
    } elsif ($! != ENOENT) {
        syserr("open old varlist file \`$varlistfile' for reading");
    }
    $fh= 'Y';
} else {
    $fh= 'STDOUT';
}
my %defdepf;
for my $dv (sort keys %predefdepfdep) {
    my $lf= $predefdepfdep{$dv};
    $defdepf{$lf}.= ', ' if length($defdepf{$lf});
    $defdepf{$lf}.= $dv;
}
for my $lf (reverse @depfields) {
    next unless defined($defdepf{$lf});
    print($fh "$varnameprefix:$lf=$defdepf{$lf}\n")
        || syserr("write output entry");
}
for my $lf (sort keys %unkdepf) {
    print($fh "$varnameprefix:$lf=$unkdepf{$lf}\n")
        || syserr("write userdef output entry");
}
close($fh) || syserr("close output");
if (!$stdout) {
    rename("$varlistfile.new",$varlistfile) ||
        syserr("install new varlist file \`$varlistfile'");
}
Reply to: