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

[SCM] Debian package checker branch, master, updated. 2.5.12-17-gcc20490



The following commit has been merged in the master branch:
commit bb37de73aadead0a072e95004c223707e1101354
Author: Niels Thykier <niels@thykier.net>
Date:   Sat Apr 20 16:13:42 2013 +0200

    L::Collect::*: Allow L::Path objects as arg to unpacked/control
    
    In unpacked and control allow callers to pass L::Path object instead a
    string.  It allows these methods to skip some sanity checking of the
    input.
    
    At the same time forbit an explicit "undef" as argument.  Previously,
    it would not have been a problem, but now it could hide a bug in the
    code (namely, a failure to check the return value of "index").
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/debian/changelog b/debian/changelog
index 3495dbf..bb521a7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -17,6 +17,8 @@ lintian (2.5.13) UNRELEASED; urgency=low
 
   * lib/*:
     + [NT] Fix a number of spelling mistakes in the POD.
+  * lib/Lintian/Collect/{Package,Binary}.pm:
+    + [NT] Accept Lintian::Path objects to unpacked and control.
   * lib/Lintian/Util.pm:
     + [NT] Fix a race condition in touch_file.
     + [NT] Add sanity check in perm2oct for bad permission
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index a43f120..d0049ef 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -136,10 +136,14 @@ sub changelog {
 
 =item control ([FILE])
 
-Returns the path to FILE in the control.tar.gz.  FILE must be relative
-to the root of the control.tar.gz and should be without leading slash
-(and and without "./").  If FILE is not in the control.tar.gz, it
-returns the path to a non-existent file entry.
+Returns the path to FILE in the control.tar.gz.  FILE must be either a
+L<Lintian::Path> object or a string denoting the requested path.  In
+the latter case, the path must be relative to the root of the
+control.tar.gz member and should be normalized.
+
+It is not permitted for FILE to be C<undef>.  If the "root" dir is
+desired either invoke this method without any arguments at all, pass
+it the correct L<Lintian::Path> or the empty string.
 
 To get a list of entries in the control.tar.gz or the file meta data
 of the entries (as L<path objects|Lintian::Path>), see
@@ -154,8 +158,10 @@ Needs-Info requirements for using I<control>: bin-pkg-control
 =cut
 
 sub control {
-    my ($self, $file) = @_;
-    return $self->_fetch_extracted_dir('control', 'control', $file);
+    ## no critic (Subroutines::RequireArgUnpacking)
+    # - see L::Collect::unpacked for why
+    my $self = shift(@_);
+    return $self->_fetch_extracted_dir('control', 'control', @_);
 }
 
 =item control_index (FILE)
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 1c6bb17..23798b6 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -24,6 +24,8 @@ use warnings;
 use parent 'Lintian::Collect';
 
 use Carp qw(croak);
+use Scalar::Util qw(blessed);
+
 use Lintian::Path;
 use Lintian::Util qw(open_gz perm2oct resolve_pkg_path);
 
@@ -36,9 +38,9 @@ Lintian::Collect::Package - Lintian base interface to binary and source package
     my ($name, $type, $dir) = ('foobar', 'source', '/path/to/lab-entry');
     my $info = Lintian::Collect->new ($name, $type, $dir);
     my $filename = "etc/conf.d/$name.conf";
-    my $file = $info->index ($filename);
+    my $file = $info->index($filename);
     if ($file && $file->is_regular_file) {
-        open my $fd, '<', $info->unpacked ($filename)
+        open my $fd, '<', $info->unpacked($file)
             or die "opening $filename: $!";
         # Use $fd ...
         close $fd;
@@ -72,10 +74,17 @@ documented in the L<Lintian::Collect> module are also available.
 =item unpacked ([FILE])
 
 Returns the path to the directory in which the package has been
-unpacked.  FILE must be relative to the root of the of the package and
-should be without leading slash (and without leading "./").  If FILE
-is not in the package, it returns the path to a non-existent file
-entry.
+unpacked.  FILE must be either a L<Lintian::Path> object or a
+string denoting the requested path.  In the latter case, the
+path must be relative to the root of the package and should be
+normalized.
+
+It is not permitted for FILE to be C<undef>.  If the "root" dir is
+desired either invoke this method without any arguments at all, pass
+it the correct L<Lintian::Path> or the empty string.
+
+If FILE is not in the package, it returns the path to a non-existent
+file entry.
 
 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
@@ -117,8 +126,14 @@ Needs-Info requirements for using I<unpacked>: unpacked
 =cut
 
 sub unpacked {
-    my ($self, $file) = @_;
-    return $self->_fetch_extracted_dir('unpacked', 'unpacked', $file);
+    ## no critic (Subroutines::RequireArgUnpacking)
+    #  - _fetch_extracted_dir checks if the FILE argument was explicitly
+    #    undef, but it relies on the size of @_ to do this.  With
+    #    unpacking we would have to use shift or check it directly here
+    #    (and duplicate said check in ::Binary::control and
+    #    ::Source::debfiles).
+    my $self = shift(@_);
+    return $self->_fetch_extracted_dir('unpacked', 'unpacked', @_);
 }
 
 =item file_info (FILE)
@@ -216,25 +231,49 @@ sub sorted_index {
 sub _fetch_extracted_dir {
     my ($self, $field, $dirname, $file) = @_;
     my $dir = $self->{$field};
+    my $filename = '';
+    my $normalized = 0;
     if ( not defined $dir ) {
         $dir = $self->lab_data_path ($dirname);
         croak "$field ($dirname) is not available" unless -d "$dir/";
         $self->{$field} = $dir;
     }
-    if (defined $file and $file ne '') {
-        # strip leading ./ - if that leaves something, return the path there
-        if ($file =~ s,^(?:\.?/)++,,go) {
-            warnings::warnif('Lintian::Collect',
-                qq{Argument to $field had leading "/" or "./"});
+
+    if (!defined($file)) {
+        if (scalar(@_) >= 4) {
+            # Was this undef explicit?
+            croak('Input file was undef');
+        }
+        $normalized = 1;
+    } else {
+        if (ref($file)) {
+            if (!blessed($file) || !$file->isa('Lintian::Path')) {
+                croak('Input file must be a string or a Lintian::Path object');
+            }
+            $filename = $file->name;
+            $normalized = 1;
+        } else {
+            $normalized = 0;
+            $filename = $file;
         }
-        if ($file =~ m{(?: ^|/ ) \.\. (?: /|$ )}xsm) {
-            # possible traversal - double check it and (if needed)
-            # stop it before it gets out of hand.
-            if (resolve_pkg_path('/', $file) eq '') {
-                croak qq{The path "$file" is not within the package root};
+    }
+
+    if ($filename ne '') {
+        if (!$normalized) {
+            # strip leading ./ - if that leaves something, return the path there
+            if ($filename =~ s,^(?:\.?/)++,,go) {
+                warnings::warnif('Lintian::Collect',
+                                 qq{Argument to $field had leading "/" or "./"});
+            }
+            if ($filename =~ m{(?: ^|/ ) \.\. (?: /|$ )}xsm) {
+                # possible traversal - double check it and (if needed)
+                # stop it before it gets out of hand.
+                if (resolve_pkg_path('/', $filename) eq '') {
+                    croak qq{The path "$file" is not within the package root};
+                }
             }
         }
-        return "$dir/$file" if $file ne '';
+        return "$dir/$filename" if $filename ne '';
     }
     return $dir;
 }
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index dad9d5f..bc709a8 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -25,6 +25,7 @@ use parent 'Lintian::Collect::Package';
 
 use Carp qw(croak);
 use Cwd();
+use Scalar::Util qw(blessed);
 
 use Lintian::Relation;
 use Parse::DebianChangelog;
@@ -548,6 +549,10 @@ should be without leading slash (and and without "./").  If FILE is
 not in the debian dir, it returns the path to a non-existent file
 entry.
 
+It is not permitted for FILE to be C<undef>.  If the "root" dir is
+desired either invoke this method without any arguments at all or use
+the empty string.
+
 The caveats of L<unpacked|Lintian::Collect::Package/unpacked ([FILE])>
 also apply to this method.
 
@@ -556,8 +561,13 @@ Needs-Info requirements for using I<debfiles>: debfiles
 =cut
 
 sub debfiles {
-    my ($self, $file) = @_;
-    return $self->_fetch_extracted_dir('debfiles', 'debfiles', $file);
+    ## no critic (Subroutines::RequireArgUnpacking)
+    # - see L::Collect::unpacked for why
+    my $self = shift(@_);
+    if (defined($_[0]) && blessed($_[0])) {
+        croak('debfiles does not accept blessed objects');
+    }
+    return $self->_fetch_extracted_dir('debfiles', 'debfiles', @_);
 }
 
 =item index (FILE)

-- 
Debian package checker


Reply to: