[SCM] Debian package checker branch, master, updated. 2.5.11-269-g4fa9095

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

The following commit has been merged in the master branch:
commit 238ff0973eb009d3b18ea031bc5cd348f1a6f0c4
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 301e76a..f85f712 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -298,6 +298,7 @@ lintian (2.5.12) UNRELEASED; urgency=low
       covered by a signature.  (Closes: #696230)
     + [ADB] Fix a typo in the matching of expected delimiters for some
       signed messages; thanks Samuel Bronson.
+    + [NT] Add sub to check if a path is contained within a given dir.
 
   * man/lintian.pod.in:
     + [NT] Document that --pedantic is the same as "-L +=pedantic".
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index bcaa756..6d2c0c4 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -88,19 +88,21 @@ symlink, it may "escape the root" and point to a file outside the lab
 
 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 resolve_pkg_path in L<Lintian::Util> or
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index 9c9fd4f..0bda4b9 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -24,7 +24,7 @@ use strict;
 use warnings;
 
 use Carp qw(croak);
-
+use Cwd qw(abs_path);
 use Exporter qw(import);
 
 use constant {
@@ -73,6 +73,7 @@ BEGIN {
                  clean_env
                  resolve_pkg_path
                  parse_boolean
+                 is_ancestor_of
                  $PKGNAME_REGEX),
                  @{ $EXPORT_TAGS{constants} }
     );
@@ -1192,6 +1193,38 @@ sub parse_boolean {
     croak "\"$str\" is not a valid boolean value";
 }
 
+=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