[SCM] Debian package checker branch, master, updated. 2.5.5-11-ge94cee4
The following commit has been merged in the master branch:
commit e94cee45f4629af3a421dff495631775b69d07b5
Author: Niels Thykier <niels@thykier.net>
Date: Wed Mar 7 13:44:45 2012 +0100
coll/*: Refactored to use new $dir argument as path to package
Pass a 3rd argument to all collections, which is the path to the
package being examined. This means that:
* lintian no longer needs to use rundir (etc.) to run collections.
* collections can now use Lintian::Collect "for free".
- previously they would have to do "cwd" (or refain from
chdir'ing).
The latter effect can be exploited to reduce the "coupling" between
various collections.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/collection/ar-info b/collection/ar-info
index a512e15..9907590 100755
--- a/collection/ar-info
+++ b/collection/ar-info
@@ -27,19 +27,20 @@ use FileHandle;
use Lintian::Command qw(spawn);
use Util qw(fail);
-($#ARGV == 1) or fail('syntax: ar-info <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: ar-info <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
-unlink('ar-info');
+if ( -e "$dir/ar-info" ) {
+ unlink "$dir/ar-info" or fail "unlink ar-info: $!";
+}
# Open before chdir, as unpacked may be a symlink
-open(INDEX, '<', 'index')
+open INDEX, '<', "$dir/index"
or fail("cannot open index file: $!");
-open(OUT, '>', 'ar-info')
+open OUT, '>', "$dir/ar-info"
or fail("cannot open ar-info file: $!");
-chdir('unpacked')
+chdir ("$dir/unpacked")
or fail("cannot chdir to unpacked directory: $!");
while (<INDEX>) {
diff --git a/collection/bin-pkg-control b/collection/bin-pkg-control
index 8b8a80d..e973a1a 100755
--- a/collection/bin-pkg-control
+++ b/collection/bin-pkg-control
@@ -26,49 +26,48 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
use Lintian::Command qw(spawn reap);
-($#ARGV == 1) or fail('syntax: bin-pkg-control <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: bin-pkg-control <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
my (@jobs, $job);
-if (-e 'control'){
- delete_dir('control') or fail('Cannot remove old control dir');
+if ( -e "$dir/control"){
+ delete_dir ("$dir/control") or fail 'Cannot remove old control dir';
}
-mkdir('control', 0777) or fail("mkdir control: $!");
+mkdir ("$dir/control", 0777) or fail "mkdir control: $!";
# The following calls use knowledge of the .deb format for speed
# (replaces dpkg-deb -e)
# extract control files' tarball
-spawn({ fail => 'error', out => 'control.tar' },
- ['ar', 'p', 'deb', 'control.tar.gz'],
+spawn ({ fail => 'error', out => "$dir/control.tar" },
+ ['ar', 'p', "$dir/deb", 'control.tar.gz'],
'|', ['gzip', '-dc']);
-$job = { fail => 'error', err => 'control-errors' };
+$job = { fail => 'error', err => "$dir/control-errors" };
push @jobs, $job;
# extract the tarball's contents
spawn($job,
- ['tar', 'xf', 'control.tar', '-C', 'control', '&']);
+ ['tar', 'xf', "$dir/control.tar", '-C', "$dir/control", '&']);
$job = { fail => 'error',
- out => 'control-index',
- err => 'control-index-errors' };
+ out => "$dir/control-index",
+ err => "$dir/control-index-errors" };
push @jobs, $job;
# create index of control.tar.gz
spawn($job,
- ['tar', 'tvf', 'control.tar'],
+ ['tar', 'tvf', "$dir/control.tar"],
'|', ['sort', '-k', '6'], '&');
reap(@jobs);
undef @jobs;
# clean up control.tar
-unlink('control.tar') or fail();
+unlink "$dir/control.tar" or fail "unlink control.tar: $!";
# fix permissions
spawn({ fail => 'error' },
- ['chmod', '-R', 'u+rX,o-w', 'control']);
+ ['chmod', '-R', 'u+rX,o-w', "$dir/control"]);
exit 0;
diff --git a/collection/changelog-file b/collection/changelog-file
index a2d4a70..a092306 100755
--- a/collection/changelog-file
+++ b/collection/changelog-file
@@ -25,26 +25,25 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: changelog-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: changelog-file <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
-unlink('changelog') or fail("cannot remove changelog file: $!")
- if ( -e 'changelog' or -l 'changelog');
+unlink "$dir/changelog" or fail "cannot remove changelog file: $!"
+ if -e "$dir/changelog" or -l "$dir/changelog";
# Pick the first of these files that exists.
-my @changelogs = ("unpacked/usr/share/doc/$pkg/changelog.Debian.gz",
- "unpacked/usr/share/doc/$pkg/changelog.Debian",
- "unpacked/usr/share/doc/$pkg/changelog.debian.gz",
- "unpacked/usr/share/doc/$pkg/changelog.debian",
- "unpacked/usr/share/doc/$pkg/changelog.gz",
- "unpacked/usr/share/doc/$pkg/changelog",
- "unpacked/usr/doc/$pkg/changelog.Debian.gz",
- "unpacked/usr/doc/$pkg/changelog.Debian",
- "unpacked/usr/doc/$pkg/changelog.debian.gz",
- "unpacked/usr/doc/$pkg/changelog.debian",
- "unpacked/usr/doc/$pkg/changelog.gz",
- "unpacked/usr/doc/$pkg/changelog");
+my @changelogs = ("$dir/unpacked/usr/share/doc/$pkg/changelog.Debian.gz",
+ "$dir/unpacked/usr/share/doc/$pkg/changelog.Debian",
+ "$dir/unpacked/usr/share/doc/$pkg/changelog.debian.gz",
+ "$dir/unpacked/usr/share/doc/$pkg/changelog.debian",
+ "$dir/unpacked/usr/share/doc/$pkg/changelog.gz",
+ "$dir/unpacked/usr/share/doc/$pkg/changelog",
+ "$dir/unpacked/usr/doc/$pkg/changelog.Debian.gz",
+ "$dir/unpacked/usr/doc/$pkg/changelog.Debian",
+ "$dir/unpacked/usr/doc/$pkg/changelog.debian.gz",
+ "$dir/unpacked/usr/doc/$pkg/changelog.debian",
+ "$dir/unpacked/usr/doc/$pkg/changelog.gz",
+ "$dir/unpacked/usr/doc/$pkg/changelog");
my $chl;
@@ -63,7 +62,7 @@ for (@changelogs) {
if (defined ($chl) && -l $chl) {
my $link = readlink $chl or fail("cannot readlink $chl: $!");
if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
- symlink('file-is-in-another-package', 'changelog')
+ symlink ("$dir/file-is-in-another-package", "$dir/changelog")
or fail("cannot create changelog symlink: $!");
undef $chl;
} elsif (! -f $chl) {
@@ -78,16 +77,16 @@ if (defined ($chl) && -l $chl) {
if (not defined $chl) {
# no changelog found
} elsif ($chl =~ /\.gz$/) {
- gunzip_file($chl, 'changelog');
+ gunzip_file ($chl, "$dir/changelog");
} elsif (-f $chl && -l $chl) {
local $_;
open (CHL, '<', $chl) or fail("cannot open $chl: $!");
- open (COPY, '>', 'changelog') or fail("cannot create changelog: $!");
+ open (COPY, '>', "$dir/changelog") or fail "cannot create changelog: $!";
print COPY while <CHL>;
close CHL;
close (COPY) or fail("cannot write changelog: $!");
} else {
- link($chl, 'changelog')
+ link ($chl, "$dir/changelog")
or fail("cannot link $chl to changelog: $!");
}
@@ -95,7 +94,7 @@ if ($chl && $chl !~ m/changelog\.debian/i) {
# Either this is a native package OR a non-native package where the
# debian changelog is missing. checks/changelog is not too happy
# with the latter case, so check looks like a Debian changelog.
- open my $fd, '<', 'changelog' or fail "Opening changelog: $!";
+ open my $fd, '<', "$dir/changelog" or fail "Opening changelog: $!";
my $ok = 0;
while ( my $line = <$fd> ) {
next if $line =~ m/^\s*+$/o;
@@ -108,14 +107,14 @@ if ($chl && $chl !~ m/changelog\.debian/i) {
}
close $fd;
# Remove it if it not the Debian changelog.
- unlink 'changelog' unless $ok;
+ unlink "$dir/changelog" unless $ok;
}
# Extract NEWS.Debian files as well, with similar precautious. Ignore any
# symlinks to other packages here; in that case, we just won't check the file.
-unlink('NEWS.Debian') or fail("cannot unlink NEWS.Debian: $!")
- if (-e 'NEWS.Debian' or -l 'NEWS.Debian');
-my $news = "unpacked/usr/share/doc/$pkg/NEWS.Debian.gz";
+unlink "$dir/NEWS.Debian" or fail "cannot unlink NEWS.Debian: $!"
+ if -e "$dir/NEWS.Debian" or -l "$dir/NEWS.Debian";
+my $news = "$dir/unpacked/usr/share/doc/$pkg/NEWS.Debian.gz";
if (-f $news) {
if (-l $news) {
my $link = readlink $news or fail("cannot readlink $chl: $!");
@@ -126,7 +125,7 @@ if (-f $news) {
}
}
if ($news) {
- gunzip_file($news, 'NEWS.Debian');
+ gunzip_file ($news, "$dir/NEWS.Debian");
}
}
diff --git a/collection/copyright-file b/collection/copyright-file
index ad11fcc..7185816 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -27,14 +27,15 @@ use Util;
use File::Copy qw(copy);
-($#ARGV == 1) or fail('syntax: copyright-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: copyright-file <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
-unlink('copyright');
+if ( -e "$dir/copyright" ) {
+ unlink "$dir/copyright" or fail "unlink copyright: $!";
+}
-my $file1 = "unpacked/usr/share/doc/$pkg/copyright";
-my $file2 = "unpacked/usr/doc/$pkg/copyright";
+my $file1 = "$dir/unpacked/usr/share/doc/$pkg/copyright";
+my $file2 = "$dir/unpacked/usr/doc/$pkg/copyright";
my $file;
if (-f $file1 ) { $file = $file1; }
@@ -46,18 +47,18 @@ else { $file = $file2; }
if (-l $file) {
my $link = readlink($file) or fail("cannot readlink $file: $!");
if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
- touch_file('copyright');
+ touch_file "$dir/copyright";
} else {
- copy($file, 'copyright') or fail("cannot copy $file: $!");
+ copy ($file, "$dir/copyright") or fail "cannot copy $file: $!";
}
} elsif (-f $file) {
- link($file, 'copyright')
+ link ($file, "$dir/copyright")
or fail("cannot link $file to copyright: $!");
} elsif (-f "$file.gz") {
- gunzip_file($file, 'copyright');
+ gunzip_file ($file, "$dir/copyright");
} else {
# no copyright file found
- touch_file('copyright');
+ touch_file ("$dir/copyright");
}
# Local Variables:
diff --git a/collection/debfiles b/collection/debfiles
index 6fc4bdf..42f48e1 100755
--- a/collection/debfiles
+++ b/collection/debfiles
@@ -26,21 +26,20 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: debfiles <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: debfiles <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
--e 'unpacked' or fail('debfiles invoked in wrong directory');
+-e "$dir/unpacked" or fail 'debfiles invoked with wrong dir argument';
-if (-e 'debfiles') {
- delete_dir('debfiles')
+if ( -e "$dir/debfiles") {
+ delete_dir ("$dir/debfiles")
or fail('cannot rm old debfiles directory');
}
-if ( -l 'unpacked/debian' ) {
+if ( -l "$dir/unpacked/debian" ) {
require Cwd;
- my $target = Cwd::abs_path ('unpacked/debian');
- my $ud = Cwd::abs_path ('unpacked');
+ my $target = Cwd::abs_path ("$dir/unpacked/debian");
+ my $ud = "$dir/unpacked";
fail ("cannot resolve debian directory symlink in $pkg: $!") unless $target;
fail ("cannot resolve unpacked dir for $pkg: $!") unless $ud;
# We need the the trailing slash on $ud to ensure $target is a subdir of $ud. However
@@ -50,7 +49,7 @@ if ( -l 'unpacked/debian' ) {
}
# Copy the whole debian directory
-copy_dir('unpacked/debian/', 'debfiles')
+copy_dir ("$dir/unpacked/debian/", "$dir/debfiles")
or fail("cannot copy unpacked/debian to debfiles: $!");
# Local Variables:
diff --git a/collection/debian-readme b/collection/debian-readme
index 79d342d..afef8a3 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -25,23 +25,22 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: debian-readme <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: debian-readme <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
-if (-f 'README.Debian') {
- unlink('README.Debian') or fail("Could not remove old README.Debian: $!");
+if ( -f "$dir/README.Debian") {
+ unlink "$dir/README.Debian" or fail "Could not remove old README.Debian: $!";
}
# Pick the first of these files that exists.
-my @readmes = ("unpacked/usr/share/doc/$pkg/README.Debian.gz",
- "unpacked/usr/share/doc/$pkg/README.Debian",
- "unpacked/usr/share/doc/$pkg/README.debian.gz",
- "unpacked/usr/share/doc/$pkg/README.debian",
- "unpacked/usr/doc/$pkg/README.Debian.gz",
- "unpacked/usr/doc/$pkg/README.Debian",
- "unpacked/usr/doc/$pkg/README.debian.gz",
- "unpacked/usr/doc/$pkg/README.debian");
+my @readmes = ("$dir/unpacked/usr/share/doc/$pkg/README.Debian.gz",
+ "$dir/unpacked/usr/share/doc/$pkg/README.Debian",
+ "$dir/unpacked/usr/share/doc/$pkg/README.debian.gz",
+ "$dir/unpacked/usr/share/doc/$pkg/README.debian",
+ "$dir/unpacked/usr/doc/$pkg/README.Debian.gz",
+ "$dir/unpacked/usr/doc/$pkg/README.Debian",
+ "$dir/unpacked/usr/doc/$pkg/README.debian.gz",
+ "$dir/unpacked/usr/doc/$pkg/README.debian");
my $file;
for (@readmes) {
@@ -53,11 +52,11 @@ for (@readmes) {
if (not defined $file) {
# no README found
- touch_file('README.Debian');
+ touch_file ("$dir/README.Debian");
} elsif ($file =~ m/\.gz$/) {
- gunzip_file($file, 'README.Debian');
+ gunzip_file ($file, "$dir/README.Debian");
} else {
- link($file, 'README.Debian')
+ link ($file, "$dir/README.Debian")
or fail("cannot link $file to README.Debian: $!");
}
diff --git a/collection/diffstat b/collection/diffstat
index 5f40a5f..62d9798 100755
--- a/collection/diffstat
+++ b/collection/diffstat
@@ -31,31 +31,31 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: diffstat <pkg> <type>');
-my $pkg = shift;
+($#ARGV == 2) or fail 'syntax: diffstat <pkg> <type> <dir>';
+my ($pkg, undef, $dir) = @ARGV;
my $data;
my $ver;
--f 'dsc' or fail('diffstat invoked in wrong directory');
+-f "$dir/dsc" or fail 'diffstat invoked with wrong dir argument';
-$data = get_dsc_info('dsc');
+$data = get_dsc_info ("$dir/dsc");
$ver = $data->{'version'};
-unlink('debian-patch') or fail("cannot unlink debian-patch: $!")
- if( -e 'debian-patch' or -l 'debian-patch');
+unlink "$dir/debian-patch" or fail "cannot unlink debian-patch: $!"
+ if -e "$dir/debian-patch" or -l "$dir/debian-patch";
$ver =~ s/^\d://; #Remove epoch for this
-my $diff_file = "${pkg}_${ver}.diff.gz";
+my $diff_file = "$dir/${pkg}_${ver}.diff.gz";
exit 0 unless (-f $diff_file);
-gunzip_file($diff_file, 'debian-patch');
+gunzip_file($diff_file, "$dir/debian-patch");
-open (STAT, '>', 'diffstat') or fail("cannot open scripts output file: $!");
+open STAT, '>', "$dir/diffstat" or fail "cannot open scripts output file: $!";
# diffstat is noisy on stderr if its stdout is not a tty.
# Shut it up by redirecting stderr to /dev/null.
open STDERR, '>', '/dev/null';
-open (DIFF, '-|', qw/diffstat -p1 debian-patch/)
+open DIFF, '-|', 'diffstat', '-p1', "$dir/debian-patch"
or fail("cannot open pipe to diffstat on debian-patch: $!");
# Copy all except last line to the STAT file
my $previous;
diff --git a/collection/doc-base-files b/collection/doc-base-files
index 1350fe0..a68b1c5 100755
--- a/collection/doc-base-files
+++ b/collection/doc-base-files
@@ -26,22 +26,20 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: doc-base-files <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: doc-base-files <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
-
-if (-e 'doc-base') {
- delete_dir('doc-base')
+if ( -e "$dir/doc-base") {
+ delete_dir ("$dir/doc-base")
or fail('cannot rm old doc-base directory');
}
-if (-d 'unpacked/usr/share/doc-base') {
- copy_dir('unpacked/usr/share/doc-base', 'doc-base')
+if ( -d "$dir/unpacked/usr/share/doc-base") {
+ copy_dir ("$dir/unpacked/usr/share/doc-base", "$dir/doc-base")
or fail('cannot copy directory unpacked/usr/share/doc-base');
} else {
# no doc-base directory
- mkdir('doc-base', 0777) or fail("cannot mkdir doc-base: $!");
+ mkdir ("$dir/doc-base", 0777) or fail "cannot mkdir doc-base: $!";
}
# Local Variables:
diff --git a/collection/file-info b/collection/file-info
index 63f2bc0..ec86e15 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -28,24 +28,21 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
use Lintian::Command qw(spawn reap);
-($#ARGV == 1) or fail('syntax: file-info <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: file-info <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
my $last = '';
my $helper = realpath("$0-helper");
-my $outfile = realpath('./file-info');
+my $outfile = "$dir/file-info";
-unlink($outfile);
-
-# Open files before we chdir, since unpacked could be a symlink (at
-# the time of writing, it never is, but it could be a reasonable way
-# of fixing #262783)
+if ( -e $outfile ) {
+ unlink($outfile) or fail "unlink file-info: $!";
+}
-open(INDEX, '<', 'index')
+open INDEX, '<', "$dir/index"
or fail("cannot open index file: $!");
-chdir('unpacked')
+chdir ("$dir/unpacked")
or fail("cannot chdir to unpacked directory: $!");
# We ignore failures from file because sometimes file returns a non-zero exit
diff --git a/collection/index b/collection/index
index 89f2543..a276508 100755
--- a/collection/index
+++ b/collection/index
@@ -34,12 +34,11 @@ use Util;
use Lintian::Command qw(spawn reap);
use Lintian::Processable::Package;
-($#ARGV == 1) or fail 'syntax: index <pkg> <type>';
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: index <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
-unlink 'index' or fail "Could not unlink index: $!" if -e 'index' && -s 'index';
-unlink 'index-errors' or fail "Could not unlink index-errors: $!" if -e 'index-errors' && -s 'index-errors';
+unlink "$dir/index" or fail "Could not unlink index: $!" if -e "$dir/index";
+unlink "$dir/index-errors" or fail "Could not unlink index-errors: $!" if -e "$dir/index-errors";
if ($type ne 'source') {
index_deb();
@@ -51,16 +50,14 @@ exit 0;
# returns all (orig) tarballs.
sub gather_tarballs {
- my $file = Cwd::realpath('dsc');
- my $dir;
+ my $file = Cwd::realpath ("$dir/dsc");
my $data;
my $version;
my @tarballs;
my $base;
my $baserev;
my $proc;
- fail "Cannot resolve \"dsc\" link for $pkg or it does not point to a file.\n" unless $file and -e $file;
- (undef, $dir, undef) = File::Spec->splitpath($file);
+ fail "Cannot resolve \"dsc\" link for $pkg or it does not point to a file." unless $file and -e $file;
# Use Lintian::Processable::Package to determine source and version as handles missing fields
# for us to some extend.
$proc = Lintian::Processable::Package->new ('source', $file);
@@ -125,8 +122,8 @@ sub index_src {
}
}
}; # End $collect = sub;
- spawn({ fail => 'never', out => $collect, err_append => 'index-errors' },
- ['tar', @tar_options, $tarball]);
+ spawn({ fail => 'never', out => $collect, err_append => "$dir/index-errors" },
+ ['tar', @tar_options, "$dir/$tarball"]);
if ($last) {
fail("tar output (for $tarball from $pkg) does not end in a newline");
}
@@ -176,7 +173,7 @@ sub index_src {
} @index;
my $filename = 'source-prefix';
$filename .= "-$compname" if $compname;
- open(PREFIX, '>', $filename)
+ open PREFIX, '>', "$dir/$filename"
or fail "opening $filename for $pkg: $!";
print PREFIX "$prefix\n";
close PREFIX or fail "closing $filename for $pkg: $!";
@@ -190,7 +187,7 @@ sub index_src {
}
# Now that we have the file names we want, write them out sorted to the index
# file.
- spawn({ fail => 'error', out_append => 'index' },
+ spawn({ fail => 'error', out_append => "$dir/index" },
sub { print @result }, '|', ['sort', '-k', '6']);
return 1;
}
@@ -200,29 +197,29 @@ sub index_deb {
my (@jobs, $job);
foreach my $file (qw(index index-errors index-owner-id)) {
- unlink $file or fail "$file: $!" if -f $file;
+ unlink "$dir/$file" or fail "$file: $!" if -f "$dir/$file";
}
$job = { fail => 'error',
- out => 'index',
- err => 'index-errors' };
+ out => "$dir/index",
+ err => "$dir/index-errors" };
push @jobs, $job;
# (replaces dpkg-deb -c)
# create index file for package
spawn($job,
- ['dpkg-deb', '--fsys-tarfile', 'deb' ],
+ ['dpkg-deb', '--fsys-tarfile', "$dir/deb" ],
'|', ['tar', 'tfv', '-'],
'|', ['sed', '-e', 's/^h/-/'],
'|', ['sort', '-k', '6'], '&');
$job = { fail => 'error',
- out => 'index-owner-id',
+ out => "$dir/index-owner-id",
err => '/dev/null' };
push @jobs, $job;
# (replaces dpkg-deb -c)
# create index file for package with owner IDs instead of names
spawn($job,
- ['dpkg-deb', '--fsys-tarfile', 'deb' ],
+ ['dpkg-deb', '--fsys-tarfile', "$dir/deb" ],
'|', ['tar', '--numeric-owner', '-tvf', '-'],
'|', ['sed', '-e', 's/^h/-/'],
'|', ['sort', '-k', '6'], '&');
diff --git a/collection/init.d b/collection/init.d
index 769e294..370e3c8 100755
--- a/collection/init.d
+++ b/collection/init.d
@@ -25,21 +25,20 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: init.d <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: init.d <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
-if (-e 'init.d') {
- delete_dir('init.d')
+if (-e "$dir/init.d") {
+ delete_dir ("$dir/init.d")
or fail('cannot rm old init.d directory');
}
-if (-d 'unpacked/etc/init.d') {
- copy_dir('unpacked/etc/init.d', 'init.d')
+if (-d "$dir/unpacked/etc/init.d") {
+ copy_dir("$dir/unpacked/etc/init.d", "$dir/init.d")
or fail('cannot copy init.d directory');
} else {
# no etc/init.d
- mkdir('init.d', 0777) or fail("cannot mkdir init.d: $!");
+ mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
}
# Local Variables:
diff --git a/collection/java-info b/collection/java-info
index e3a85bb..f8ff49d 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -25,18 +25,20 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib/";
use Util qw(fail);
+my ($pkg, undef, $dir) = @ARGV;
+
# Sanity check
-unless (-d 'unpacked/') {
- fail "java-info called in wrong directory!";
+unless ( -d "$dir/unpacked/") {
+ fail "java-info called with the wrong dir argument!";
}
-open (INDEX, '<', 'index')
- or fail "cannot open index: $!\n";
+open INDEX, '<', "$dir/index"
+ or fail "cannot open index: $!";
-open (OUT, '>', 'java-info')
+open OUT, '>', "$dir/java-info"
or fail "cannot open java-info: $!";
-chdir ('unpacked')
+chdir ("$dir/unpacked")
or fail "unable to chdir to unpacked: $!";
while (<INDEX>) {
diff --git a/collection/md5sums b/collection/md5sums
index f695efc..f6dd186 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -22,19 +22,20 @@
use strict;
use warnings;
-use Cwd();
use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn reap);
use Util;
-($#ARGV == 1) or fail('syntax: md5sums <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
-my $dir = Cwd::cwd();
+($#ARGV == 2) or fail 'syntax: md5sums <pkg> <type> <dir>';
-unlink('md5sums');
-chdir('unpacked')
+my ($pkg, $type, $dir) = @ARGV;
+
+if ( -e "$dir/md5sums" ) {
+ unlink "$dir/md5sums" or fail "unlink md5sums: $!";
+}
+
+chdir ("$dir/unpacked")
or fail("cannot chdir to unpacked directory: $!");
my %opts = ( pipe_in => FileHandle->new,
diff --git a/collection/menu-files b/collection/menu-files
index 3bd390b..865fb25 100755
--- a/collection/menu-files
+++ b/collection/menu-files
@@ -25,16 +25,15 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: menu-files <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: menu-files <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
-if (-e 'menu') {
- delete_dir('menu')
+if ( -e "$dir/menu") {
+ delete_dir ("$dir/menu")
or fail('cannot rm old menu directory');
}
-mkdir('menu', 0777) or fail("cannot mkdir menu: $!");
+mkdir ("$dir/menu", 0777) or fail ("cannot mkdir menu: $!");
my %dirs;
$dirs{'share'} = 'usr/share/menu';
@@ -42,12 +41,12 @@ $dirs{'lib'} = 'usr/lib/menu';
$dirs{'methods'} = 'etc/menu-methods';
while (my ($shortn, $path) = each %dirs) {
- if (-d "unpacked/$path") {
- copy_dir("unpacked/$path", "menu/$shortn")
+ if (-d "$dir/unpacked/$path") {
+ copy_dir ("$dir/unpacked/$path", "$dir/menu/$shortn")
or fail("cannot copy unpacked/$path/ directory");
} else {
# no menu directory
- mkdir("menu/$shortn", 0777) or fail("cannot mkdir menu/$shortn: $!");
+ mkdir ("$dir/menu/$shortn", 0777) or fail ("cannot mkdir menu/$shortn: $!");
}
}
diff --git a/collection/objdump-info b/collection/objdump-info
index 51fdb1b..5b7f619 100755
--- a/collection/objdump-info
+++ b/collection/objdump-info
@@ -26,15 +26,17 @@
use strict;
use warnings;
+my (undef, undef, $dir) = @ARGV;
+
my $failed = 0;
-open (FILES, '<', 'file-info')
+open FILES, '<', "$dir/file-info"
or fail("cannot open file-info: $!");
-open (OUT, '>', 'objdump-info')
+open OUT, '>', "$dir/objdump-info"
or fail("cannot open objdump-info: $!");
-chdir ('unpacked')
+chdir ("$dir/unpacked")
or fail ("unable to chdir to unpacked: $!\n");
while (<FILES>) {
diff --git a/collection/override-file b/collection/override-file
index 9959476..94578cf 100755
--- a/collection/override-file
+++ b/collection/override-file
@@ -26,24 +26,23 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: override-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: override-file <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
--d 'unpacked' or fail('override-file invoked in wrong directory');
+-d "$dir/unpacked" or fail 'override-file invoked with wrong dir argument';
-if (-e 'override'){
- unlink('override') or fail("could not remove old override file: $!");
+if ( -e "$dir/override"){
+ unlink "$dir/override" or fail "could not remove old override file: $!";
}
# Pick the first of these files that exists. Prefer source/lintian-overrides
# to source.lintian-overrides for source packages.
my (@overrides, $file);
if ($type eq 'source') {
- @overrides = qw(unpacked/debian/source/lintian-overrides
- unpacked/debian/source.lintian-overrides);
+ @overrides = ("$dir/unpacked/debian/source/lintian-overrides",
+ "$dir/unpacked/debian/source.lintian-overrides");
} else {
- @overrides = ("unpacked/usr/share/lintian/overrides/$pkg");
+ @overrides = ("$dir/unpacked/usr/share/lintian/overrides/$pkg");
}
for my $override (@overrides) {
if (-f $override) {
@@ -56,9 +55,9 @@ for my $override (@overrides) {
if (not defined $file) {
# no override found
} elsif ($file =~ /\.gz$/) {
- gunzip_file($file, 'override');
+ gunzip_file ($file, "$dir/override");
} else {
- link($file, 'override')
+ link ($file, "$dir/override")
or fail("cannot link $file to override: $!");
}
diff --git a/collection/scripts b/collection/scripts
index 437506d..7b8acf3 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -25,8 +25,10 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib/";
use Util qw(fail);
-open(SCRIPTS, '>', 'scripts') or fail("cannot open scripts output file: $!");
-open(INDEX, '<', 'index') or fail("cannot open index file: $!");
+my (undef, undef, $dir) = @ARGV;
+
+open SCRIPTS, '>', "$dir/scripts" or fail "cannot open scripts output file: $!";
+open INDEX, '<', "$dir/index" or fail "cannot open index file: $!";
my $file;
my $magic;
@@ -43,7 +45,7 @@ while (<INDEX>) {
$file =~ s/ link to .*//; # cut off info about hard links
# This used to call fail() instead of next. However, the check to
# see if all files in the index can be opened should be done elsewhere.
- open(FILE, '<', "unpacked/$file") or next;
+ open(FILE, '<', "$dir/unpacked/$file") or next;
if (read(FILE, $magic, 2) and $magic eq '#!' and not eof(FILE)) {
$scriptpath = <FILE>;
chomp($scriptpath);
@@ -70,15 +72,15 @@ while (<INDEX>) {
close(INDEX);
close(SCRIPTS) or fail("cannot write scripts file: $!");
-open(SCRIPTS, '>', 'control-scripts')
+open SCRIPTS, '>', "$dir/control-scripts"
or fail("cannot open control-scripts output file: $!");
-opendir(CONTROL, 'control')
+opendir CONTROL, "$dir/control"
or fail("cannot read control directory: $!");
for $file (readdir CONTROL) {
- next unless -f "control/$file";
- open(FILE, '<', "control/$file") or fail("cannot open control/$file: $!");
+ next if -l "$dir/control/$file" or ! -f _;
+ open FILE, '<', "$dir/control/$file" or fail "cannot open control/$file: $!";
if (read(FILE, $magic, 2) and $magic eq '#!') {
$scriptpath = <FILE>;
$scriptpath =~ s/^\s*(\S*).*/$1/s;
diff --git a/collection/strings b/collection/strings
index b74b88f..c8153a2 100755
--- a/collection/strings
+++ b/collection/strings
@@ -27,19 +27,26 @@ use Util;
use Lintian::Command qw(spawn);
use Lintian::Command::Simple;
-($#ARGV == 1) or fail('syntax: strings <pkg> <type>');
+($#ARGV == 2) or fail('syntax: strings <pkg> <type> <dir>');
--f 'file-info'
- or fail('file-info invoked in wrong directory');
+my (undef, undef, $dir) = @ARGV;
-unlink('elf-index');
-delete_dir('strings');
+-f "$dir/file-info"
+ or fail 'strings invoked in wrong directory';
-open(ELF_INDEX, '>', 'elf-index')
- or fail("Could not open 'elf-index' for writing: $!\n");
+if ( -e "$dir/elf-index" ) {
+ unlink "$dir/elf-index" or fail "unlink elf-index: $!";
+}
+
+if ( -d "$dir/strings" ) {
+ delete_dir ("$dir/strings") or fail "rmdir strings: $!";
+}
+
+open ELF_INDEX, '>', "$dir/elf-index"
+ or fail "Could not open 'elf-index' for writing: $!";
-open(FILE_INFO, '<', 'file-info')
- or fail("Could not open 'file-info' for reading: $!\n");
+open FILE_INFO, '<', "$dir/file-info"
+ or fail "Could not open 'file-info' for reading: $!";
while (<FILE_INFO>) {
next unless(m/^(.+?)\x00\s+[^,]*\bELF\b/);
@@ -49,13 +56,13 @@ while (<FILE_INFO>) {
next if ($bin =~ m,^/usr/lib/debug/,);
- my $dir = $bin;
- $dir =~ s,/[^/]+?$,,;
+ my $elfdir = $bin;
+ $elfdir =~ s,/[^/]+?$,,;
- Lintian::Command::Simple::run('mkdir', '-p', "strings/$dir") == 0
- or fail("Failed to create directory 'strings/$dir'\n");
+ Lintian::Command::Simple::run ('mkdir', '-p', "$dir/strings/$elfdir") == 0
+ or fail "Failed to create directory 'strings/$elfdir'";
- spawn({out => "strings/$bin", fail => 'error'}, ['strings', "unpacked/$bin"]);
+ spawn ({out => "$dir/strings/$bin", fail => 'error'}, ['strings', "$dir/unpacked/$bin"]);
}
close(ELF_INDEX) or fail("cannot write elf-index file: $!");
diff --git a/collection/unpacked b/collection/unpacked
index bf49c53..9b361d6 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -27,17 +27,15 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn);
use Util;
-($#ARGV == 1) or fail('syntax: unpacked <package> <type>');
+($#ARGV == 2) or fail('syntax: unpacked <package> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
-my $pkg = shift;
-my $type = shift;
-
-if (-d 'unpacked/') {
- delete_dir('unpacked/') or
+if (-d "$dir/unpacked/") {
+ delete_dir ("$dir/unpacked/") or
fail("failed to remove unpacked directory of $pkg");
}
-if (-f 'unpacked-errors') {
- unlink('unpacked-errors') or
+if (-f "$dir/unpacked-errors") {
+ unlink ("$dir/unpacked-errors") or
fail("failed to remove unpacked-errors file of $pkg");
}
# If we are asked to only remove the files stop right here
@@ -49,12 +47,12 @@ if ($type eq 'source') {
if (can_use_dpkg_source()) {
# Ignore STDOUT of the child process because older versions of
# dpkg-source print things out even with -q.
- my $opts = { out => '/dev/null', err => 'unpacked-errors' };
+ my $opts = { out => '/dev/null', err => "$dir/unpacked-errors" };
my @args = ('-q');
push @args, '--no-check' if $ENV{'LINTIAN_COLL_UNPACKED_SKIP_SIG'};
print "N: Using dpkg-source to unpack $pkg\n" if $ENV{'LINTIAN_DEBUG'};
- unless (spawn($opts, ['dpkg-source', @args, '-x', 'dsc', 'unpacked'])) {
- open(ERRORS, '<', 'unpacked-errors')
+ unless (spawn ($opts, ['dpkg-source', @args, '-x', "$dir/dsc", "$dir/unpacked"])) {
+ open ERRORS, '<', "$dir/unpacked-errors"
or fail("cannot open unpacked-errors: $!");
print STDERR while <ERRORS>;
close ERRORS;
@@ -62,26 +60,26 @@ if ($type eq 'source') {
}
} else {
print "N: Using libdpkg-perl to unpack $pkg\n" if $ENV{'LINTIAN_DEBUG'};
- libdpkg_unpack_dsc('dsc', 'unpacked');
+ libdpkg_unpack_dsc("$dir/dsc", "$dir/unpacked");
}
# fix permissions
spawn({ fail => 'error' },
- ['chmod', '-R', 'u+rwX,o+rX,o-w', 'unpacked']);
+ ['chmod', '-R', 'u+rwX,o+rX,o-w', "$dir/unpacked"]);
} else {
- mkdir('unpacked', 0777) or fail("mkdir unpacked: $!");
+ mkdir ("$dir/unpacked", 0777) or fail "mkdir unpacked: $!";
# avoid using dpkg-deb -x; this pipeline is far faster. I got a factor 2
# improvement on large debs, and factor 1.5 on small debs.
# I heard it's because dpkg-deb syncs while writing. -- Richard
- my $opts = { err => 'unpacked-errors' };
+ my $opts = { err => "$dir/unpacked-errors" };
spawn($opts,
- ['dpkg-deb', '--fsys-tarfile', 'deb'],
- '|', ['tar', 'xf', '-', '-C', 'unpacked']);
+ ['dpkg-deb', '--fsys-tarfile', "$dir/deb"],
+ '|', ['tar', 'xf', '-', '-C', "$dir/unpacked"]);
unless ($opts->{success}) {
- open(ERRORS, '<', 'unpacked-errors')
+ open ERRORS, '<', "$dir/unpacked-errors"
or fail("cannot open unpacked-errors: $!");
print STDERR while <ERRORS>;
close ERRORS;
@@ -90,7 +88,7 @@ if ($type eq 'source') {
# fix permissions
spawn({ fail => 'error' },
- ['chmod', '-R', 'u+rwX,go-w', 'unpacked']);
+ ['chmod', '-R', 'u+rwX,go-w', "$dir/unpacked"]);
}
sub libdpkg_unpack_dsc {
diff --git a/debian/changelog b/debian/changelog
index 7e56eb1..20d7c60 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -19,12 +19,18 @@ lintian (2.5.6) UNRELEASED; urgency=low
+ [NT] Added trailing slash to copyright-format URLs in tag
descriptions for consistency with the policy.
+ * collection/*:
+ + [NT] Removed assumption that "cwd" is the same as the
+ directory for the package being examined.
* collection/java-info:
+ [NT] Added missing "use Util".
* collection/scripts:
+ [NT] Use "fail" from Util.pm rather than using an embedded
copy.
+ * frontend/lintian:
+ + [NT] Pass directory of the package to the collections.
+
* lib/Lintian/Tag/Info.pm:
+ [NT] Fixed issue where "Experimental: no" was handled as a
"yes" when generating a tag description.
diff --git a/frontend/lintian b/frontend/lintian
index cb666c5..ee480f6 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -1273,7 +1273,7 @@ sub auto_clean_package {
next unless $lpkg->is_coll_finished ($coll, $ci->{'version'});
my $script = "$opt{'LINTIAN_ROOT'}/collection/$ci->{'script'}";
debug_msg(1, "Auto removing: $ci->{'script'} ...");
- unless (Lintian::Command::Simple::rundir($base, $script, $pkg_name, "remove-${pkg_type}") == 0) {
+ unless (Lintian::Command::Simple::run ($script, $pkg_name, "remove-${pkg_type}", $base) == 0) {
warning("removing collect info $coll about package $pkg_name failed",
"skipping cleanup of $pkg_type package $pkg_name");
return 0;
@@ -1393,7 +1393,7 @@ sub unpack_group {
debug_msg(1, "Collecting info: $coll ...");
my $script = "$opt{'LINTIAN_ROOT'}/collection/$ci->{'script'}";
my $cmd = Lintian::Command::Simple->new();
- unless ($cmd->background_dir($base, $script, $pkg_name, $pkg_type) > 0) {
+ unless ($cmd->background ($script, $pkg_name, $pkg_type, $base) > 0) {
warning("collect info $coll about package $pkg_name failed",
"skipping $action of $pkg_type package $pkg_name");
$exit_code = 2;
diff --git a/t/scripts/unpack-level.t b/t/scripts/unpack-level.t
index 8d215cc..62bf298 100755
--- a/t/scripts/unpack-level.t
+++ b/t/scripts/unpack-level.t
@@ -31,7 +31,7 @@ my @l2refs = (
qr|->unpacked|,
qr<unpacked/>,
qr<unpacked-errors>,
- qr<chdir\s*\(\s*["']unpacked/?['"]\s*\)>,
+ qr<chdir\s*\(\s*["'](?:\$dir/)?unpacked/?['"]\s*\)>,
);
# For each desc file, load the first stanza of the file and check that if
--
Debian package checker
Reply to: