[SCM] Debian package checker branch, wheezy, updated. 2.5.10.4-15-ge0dc594

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the wheezy branch:
commit e725c588cb6091461a1f0c52c9f383109163bf22
Author: Niels Thykier <niels@thykier.net>
Date:   Fri Apr 5 10:01:27 2013 +0200

    L::Util: Add is_ancestor_of function
    
    This function can test if a given path is "contained" within a given
    dir (or is the dir itself).
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/debian/changelog b/debian/changelog
index 2292bd2..126ffd2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -16,6 +16,10 @@ lintian (2.5.10.5) unstable; urgency=low
     + [NT] Fix path traversal issue that could leak information
       about the host system.
 
+  * lib/Lintian/Util.pm:
+    + [NT] Add sub to check if a path is contained within a given dir.
+
+
  -- Niels Thykier <niels@thykier.net>  Fri, 05 Apr 2013 17:15:00 +0200
 
 lintian (2.5.10.4) unstable; urgency=low
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index ce0cef2..6e879cd 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -288,32 +288,41 @@ unpacked.  If C<$name> is given, it will return the path to that
 specific file (or dir).  The method will strip any leading "./" and
 "/" from C<$name>, but it will not check if C<$name> actually exists
 nor will it check for path traversals.
-  Caller is responsible for checking the sanity of the path passed to
-unpacked and verifying that the returned path points to the expected
-file.
 
 The path returned is not guaranteed to be inside the Lintian Lab as
 the package may have been unpacked outside the Lab (e.g. as
 optimization).
 
+Caveat with symlinks: Package is extracted as is and the path returned
+by this method points to the extracted file object.  If this is a
+symlink, it may "escape the root" and point to a file outside the lab
+(and a path traversal).
+
 The following code may be helpful in checking for path traversal:
 
- use Cwd qw(realpath);
+ use Lintian::Util qw(is_ancestor_of);
 
  my $collect = ... ;
  my $file = '../../../etc/passwd';
- # Append slash to follow symlink if $collect->unpacked returns a symlink
- my $uroot = realpath($collect->unpacked() . '/');
- my $ufile = realpath($collect->unpacked($file));
- if ($ufile =~ m,^$uroot,) {
+ my $uroot = $collect->unpacked;
+ my $ufile = $collect->unpacked($file);
+ # $uroot will exist, but $ufile might not.
+ if ( -e $ufile && is_ancestor_of($uroot, $ufile)) {
     # has not escaped $uroot
     do_stuff($ufile);
- } else {
+ } elsif ( -e $ufile) {
     # escaped $uroot
     die "Possibly path traversal ($file)";
+ } else {
+    # Does not exists
  }
 
-Alternatively one can use Lintian::Util::resolve_pkg_path.
+Alternatively one can use resolve_pkg_path in L<Lintian::Util> or
+L<link_resolved|Lintian::Path/link_resolved>.
+
+To get a list of entries in the package or the file meta data of the
+entries (as L<path objects|Lintian::Path>), see L</sorted_index> and
+L</index (FILE)>.
 
 =item file_info
 
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index 293ec62..38ec67f 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -24,6 +24,8 @@ use strict;
 use warnings;
 
 use base 'Exporter';
+use Carp qw(croak);
+use Cwd qw(abs_path);
 
 use constant {
   DCTRL_DEBCONF_TEMPLATE => 1,
@@ -64,7 +66,8 @@ BEGIN {
                  perm2oct
                  check_path
                  clean_env
-                 resolve_pkg_path),
+                 resolve_pkg_path
+                 is_ancestor_of),
                  @{ $EXPORT_TAGS{constants} }
     );
 
@@ -1060,6 +1063,38 @@ sub resolve_pkg_path {
     return join '/', @cc;
 }
 
+=item is_ancestor_of(PARENTDIR, PATH)
+
+Returns true if and only if PATH is PARENTDIR or a path stored
+somewhere within PARENTDIR (or its subdirs).
+
+This function will resolve the paths; any failure to resolve the path
+will cause a trappable error.
+
+=cut
+
+sub is_ancestor_of {
+    my ($ancestor, $file) = @_;
+    my $resolved_file = abs_path($file)
+        // croak("resolving $file failed: $!");
+    my $resolved_ancestor = abs_path($ancestor)
+        // croak("resolving $ancestor failed: $!");
+    my $len;
+    return 1 if $resolved_ancestor eq $resolved_file;
+    # add a slash, "path/some-dir" is not "path/some-dir-2" and this
+    # allows us to blindly match against the root dir.
+    $resolved_file .= '/';
+    $resolved_ancestor .= '/';
+
+    # If $resolved_file is contained within $resolved_ancestor, then
+    # $resolved_ancestor will be a prefix of $resolved_file.
+    $len = length($resolved_ancestor);
+    if (substr($resolved_file, 0, $len) eq $resolved_ancestor) {
+        return 1;
+    }
+    return 0;
+}
+
 =back
 
 =head1 SEE ALSO

-- 
Debian package checker