[SCM] Debian package checker branch, infra-513663, updated. 2.4.3-310-g5e32432
The following commit has been merged in the infra-513663 branch:
commit 5e32432ba96fedba4b347d2ccdae024063846dfa
Author: Niels Thykier <niels@thykier.net>
Date: Fri Mar 11 23:31:16 2011 +0100
Migrated unpack-binpkg-l1 to collection
diff --git a/collection/ar-info.desc b/collection/ar-info.desc
index cef7299..b7f2eec 100644
--- a/collection/ar-info.desc
+++ b/collection/ar-info.desc
@@ -2,5 +2,5 @@ Collector-Script: ar-info
Author: Stéphane Glondu <steph@glondu.net>
Info: This script runs the "ar t" command over all .a files of package.
Type: binary
-Needs-Info: unpacked, fields
+Needs-Info: unpacked, fields, index
Version: 1
diff --git a/collection/file-info.desc b/collection/file-info.desc
index d943008..d50393a 100644
--- a/collection/file-info.desc
+++ b/collection/file-info.desc
@@ -3,4 +3,4 @@ Author: Richard Braakman <dark@xs4all.nl>
Info: This script runs the file(1) command over all files of any kind of package.
Type: binary, udeb, source
Version: 1
-Needs-Info: unpacked, fields
+Needs-Info: unpacked, fields, index
diff --git a/unpack/unpack-binpkg-l1 b/collection/index
similarity index 74%
rename from unpack/unpack-binpkg-l1
rename to collection/index
index 2311c78..eedc12a 100755
--- a/unpack/unpack-binpkg-l1
+++ b/collection/index
@@ -27,52 +27,45 @@ use strict;
use warnings;
use vars qw($verbose);
-($#ARGV == 1) or die 'syntax: unpack-binpkg-l1 <base-dir> <deb-file>';
-my $base_dir = shift;
-my $file = shift;
-
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
use Lintian::Command qw(spawn reap);
-# stat $file
-(my @stat = stat $file) or fail("$file: cannot stat: $!");
+($#ARGV == 1) or fail 'syntax: index <pkg> <type>';
+my $pkg = shift;
+my $type = shift;
my (@jobs, $job);
-# create directory in lab
-print "N: Creating directory $base_dir ...\n" if $verbose;
-mkdir($base_dir, 0777) or fail("mkdir $base_dir: $!");
-
-symlink($file,"$base_dir/deb") or fail("symlink: $!");
+foreach my $file qw(index index-errors index-owner-id) {
+ unlink $file or fail "$file: $!" if -f $file;
+}
$job = { fail => 'error',
- out => "$base_dir/index",
- err => "$base_dir/index-errors" };
+ out => 'index',
+ err => 'index-errors' };
push @jobs, $job;
# (replaces dpkg-deb -c)
# create index file for package
spawn($job,
- ['dpkg-deb', '--fsys-tarfile', $file ],
+ ['dpkg-deb', '--fsys-tarfile', 'deb' ],
'|', ['tar', 'tfv', '-'],
'|', ['sed', '-e', 's/^h/-/'],
'|', ['sort', '-k', '6'], '&');
$job = { fail => 'error',
- out => "$base_dir/index-owner-id",
+ out => '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', $file],
+ ['dpkg-deb', '--fsys-tarfile', 'deb' ],
'|', ['tar', '--numeric-owner', '-tvf', '-'],
'|', ['sed', '-e', 's/^h/-/'],
'|', ['sort', '-k', '6'], '&');
-
-
reap(@jobs);
undef @jobs;
diff --git a/collection/index.desc b/collection/index.desc
new file mode 100644
index 0000000..cb68914
--- /dev/null
+++ b/collection/index.desc
@@ -0,0 +1,6 @@
+Collector-Script: index
+Info: This script create an index file of the contents in the
+ binary package.
+Type: binary, udeb
+Version: 1
+
diff --git a/collection/md5sums.desc b/collection/md5sums.desc
index bb2a40d..2dfdfd7 100644
--- a/collection/md5sums.desc
+++ b/collection/md5sums.desc
@@ -3,4 +3,4 @@ Author: Richard Braakman <dark@xs4all.nl>
Info: This script runs the md5sums(1) over all files in a binary package.
Type: binary, udeb
Version: 1
-Needs-Info: unpacked, fields
+Needs-Info: unpacked, fields, index
diff --git a/collection/scripts.desc b/collection/scripts.desc
index 6f43a8d..31be29a 100644
--- a/collection/scripts.desc
+++ b/collection/scripts.desc
@@ -7,4 +7,4 @@ Info: This script scans a binary package for scripts that start with #! and
because linux only looks at the first word when executing a script.
Type: binary, udeb
Version: 1
-Needs-Info: unpacked, bin-pkg-control
+Needs-Info: unpacked, bin-pkg-control, index
diff --git a/lib/Lab/Package.pm b/lib/Lab/Package.pm
index 29766bf..37d32d6 100644
--- a/lib/Lab/Package.pm
+++ b/lib/Lab/Package.pm
@@ -187,13 +187,19 @@ sub create_entry(){
# It already exists.
return 1 if ($self->entry_exists());
# We still use the "legacy" unpack for some things.
- return $self->_unpack() unless ($pkg_type eq 'changes');
+ return $self->_unpack() unless ($pkg_type ne 'source');
unless (-d $base_dir) {
mkdir($base_dir, 0777) or return 0;
$madedir = 1;
}
- $link = "$base_dir/changes";
+ if ($pkg_type eq 'changes'){
+ $link = "$base_dir/changes";
+ } elsif ($pkg_type eq 'binary' or $pkg_type eq 'udeb') {
+ $link = "$base_dir/deb";
+ } else {
+ fail "create_entry cannot handle $pkg_type";
+ }
unless (symlink($pkg_path, $link)){
# "undo" the mkdir if the symlink fails.
rmdir($base_dir) if($madedir);
@@ -238,10 +244,7 @@ sub _unpack {
# create new directory
debug_msg(1, "Unpacking package ...");
- if (($pkg_type eq 'binary') || ($pkg_type eq 'udeb')) {
- Lintian::Command::Simple::run("$ENV{LINTIAN_ROOT}/unpack/unpack-binpkg-l1", $base_dir, $pkg_path) == 0
- or return 0;
- } elsif ($pkg_type eq 'source') {
+ if ($pkg_type eq 'source') {
Lintian::Command::Simple::run("$ENV{LINTIAN_ROOT}/unpack/unpack-srcpkg-l1", $base_dir, $pkg_path) == 0
or return 0;
} else {
--
Debian package checker
Reply to: