[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: