Dpkg::Shlibs::find_library() tries harder to return the canonical name

When it finds a library in a directory which is just a symlink to another
directory that is also considered, remember the other directory name as
the canonical one. And uses the new canonpath() to also simplify path
names containing "/../".

ChangeLog

@@ -1,3 +1,12 @@
+2007-12-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Shlibs.pm (find_library): When it finds a library
+	in a directory which is just a symlink to another directory that
+	is also considered, remember the other directory name as the
+	canonical one.
+	* scripts/Dpkg/Path.pm: Add new function canonpath() and
+	resolve_symlink().
+
 2007-12-05  Frank Lichtenheld  <djpig@debian.org>
 
 	* scripts/dpkg-buildpackage.pl: Add new

debian/changelog

@@ -17,6 +17,11 @@ dpkg (1.14.13) UNRELEASED; urgency=low
     Closes: #109794, #200454
   * Bump Standards-Version to 3.7.3 (no changes)
 
+  [ Raphael Hertzog ]
+  * When dpkg-shlibdeps finds a lib in a directory which is just a symlink to
+    another directory that is also considered, remember the other directory
+    name as the canonical one. Closes: #453885
+
   [ Updated man pages translations ]
   * Swedish (Peter Karlsson)
 

scripts/Dpkg/Path.pm

@@ -20,10 +20,12 @@ use strict;
 use warnings;
 
 use Exporter;
+use File::Spec;
 use Cwd qw(realpath);
 our @ISA = qw(Exporter);
 our @EXPORT_OK = qw(get_pkg_root_dir relative_to_pkg_root
-		    guess_pkg_root_dir check_files_are_the_same);
+		    guess_pkg_root_dir check_files_are_the_same
+		    resolve_symlink canonpath);
 
 =head1 NAME
 
@@ -119,6 +121,62 @@ sub check_files_are_the_same($$) {
     return $result;
 }
 
+
+=item canonpath($file)
+
+This function returns a cleaned path. It simplifies double //, and remove
+/./ and /../ intelligently. For /../ it simplifies the path only if the
+previous element is not a symlink. Thus it should only be used on real
+filenames.
+
+=cut
+sub canonpath($) {
+    my $path = shift;
+    $path = File::Spec->canonpath($path);
+    my ($v, $dirs, $file) = File::Spec->splitpath($path);
+    my @dirs = File::Spec->splitdir($dirs);
+    my @new;
+    foreach my $d (@dirs) {
+	if ($d eq '..') {
+	    if (scalar(@new) > 0 and $new[-1] ne "..") {
+		next if $new[-1] eq ""; # Root directory has no parent
+		my $parent = File::Spec->catpath($v,
+			File::Spec->catdir(@new), '');
+		if (not -l $parent) {
+		    pop @new;
+		} else {
+		    push @new, $d;
+		}
+	    } else {
+		push @new, $d;
+	    }
+	} else {
+	    push @new, $d;
+	}
+    }
+    return File::Spec->catpath($v, File::Spec->catdir(@new), $file);
+}
+
+=item $newpath = resolve_symlink($symlink)
+
+Return the filename of the file pointed by the symlink. The new name is
+canonicalized by canonpath().
+
+=cut
+sub resolve_symlink($) {
+    my $symlink = shift;
+    my $content = readlink($symlink);
+    return undef unless defined $content;
+    if (File::Spec->file_name_is_absolute($content)) {
+	return canonpath($content);
+    } else {
+	my ($link_v, $link_d, $link_f) = File::Spec->splitpath($symlink);
+	my ($cont_v, $cont_d, $cont_f) = File::Spec->splitpath($content);
+	my $new = File::Spec->catpath($link_v, $link_d . "/" . $cont_d, $cont_f);
+	return canonpath($new);
+    }
+}
+
 =back
 
 =head1 AUTHOR

scripts/Dpkg/Shlibs.pm

@@ -27,6 +27,7 @@ use File::Spec;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(syserr);
 use Dpkg::Shlibs::Objdump;
+use Dpkg::Path qw(resolve_symlink canonpath);
 
 use constant DEFAULT_LIBRARY_PATH =>
     qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
@@ -77,10 +78,21 @@ sub find_library {
     $root =~ s{/+$}{};
     my @rpath = @{$rpath};
     foreach my $dir (@rpath, @librarypaths) {
-	if (-e "$root$dir/$lib") {
-	    my $libformat = Dpkg::Shlibs::Objdump::get_format("$root$dir/$lib");
+	my $checkdir = "$root$dir";
+	# If the directory checked is a symlink, check if it doesn't
+	# resolve to another public directory (which is then the canonical
+	# directory to use instead of this one). Typical example
+	# is /usr/lib64 -> /usr/lib on amd64.
+	if (-l $checkdir) {
+	    my $newdir = resolve_symlink($checkdir);
+	    if (grep { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) {
+		$checkdir = $newdir;
+	    }
+	}
+	if (-e "$checkdir/$lib") {
+	    my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
 	    if ($format eq $libformat) {
-		return File::Spec->canonpath("$root$dir/$lib");
+		return canonpath("$checkdir/$lib");
 	    }
 	}
     }