[SCM] Debian package checker branch, master, updated. 2.0.0-29-gac85d00
The following commit has been merged in the master branch:
commit 0600fed3da48cc6ffeb1c905044e29c2f7c70ecd
Author: Frank Lichtenheld <djpig@debian.org>
Date: Fri Oct 17 00:22:32 2008 +0200
unpack/*: Convert to Lintian::Command and Util
diff --git a/unpack/unpack-binpkg-l1 b/unpack/unpack-binpkg-l1
index b2d8e6c..d555c76 100755
--- a/unpack/unpack-binpkg-l1
+++ b/unpack/unpack-binpkg-l1
@@ -32,8 +32,8 @@ my $file = shift;
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Pipeline;
use Util;
+use Lintian::Command qw(spawn);
# stat $file
(my @stat = stat $file) or fail("$file: cannot stat: $!");
@@ -49,45 +49,41 @@ symlink($file,"$base_dir/deb") or fail("symlink: $!");
# (replaces dpkg-deb -e)
# extract control files' tarball
-pipeline((sub { exec 'ar', 'p', $file, 'control.tar.gz' }),
- (sub { exec 'gzip', '-dc' }),
- "$base_dir/control.tar") == 0
- or fail();
+spawn({ fail => 'error', out => "$base_dir/control.tar" },
+ ['ar', 'p', $file, 'control.tar.gz'],
+ '|', ['gzip', '-dc']);
# extract the tarball's contents
-spawn("tar", "xf", "$base_dir/control.tar", "-C", "$base_dir/control") == 0
- or fail();
+spawn({ fail =>'error' },
+ ["tar", "xf", "$base_dir/control.tar", "-C", "$base_dir/control"]);
# create index of control.tar.gz
-pipeline((sub { exec "tar", "tvf", "$base_dir/control.tar" }),
- (sub { exec "sort", "-k", "6" }),
- "$base_dir/control-index") == 0
- or fail();
+spawn({ fail => 'error', out => "$base_dir/control-index" },
+ ["tar", "tvf", "$base_dir/control.tar"],
+ '|', ["sort", "-k", "6"]);
# clean up control.tar
unlink("$base_dir/control.tar") or fail();
# fix permissions
-spawn("chmod", "-R", "u+rX,o-w", "$base_dir/control") == 0
- or fail();
+spawn({ fail => 'error' },
+ ["chmod", "-R", "u+rX,o-w", "$base_dir/control"]);
# (replaces dpkg-deb -c)
# create index file for package
-pipeline((sub { exec "dpkg-deb", "--fsys-tarfile", $file }),
- (sub { exec "tar", "tfv", "-" }),
- (sub { exec "sed", "-e", "s/^h/-/" }),
- (sub { exec "sort", "-k", "6" }),
- "$base_dir/index") == 0
- or fail();
+spawn({ fail => 'error', out => "$base_dir/index" },
+ ["dpkg-deb", "--fsys-tarfile", $file ],
+ '|', ["tar", "tfv", "-"],
+ '|', ["sed", "-e", "s/^h/-/"],
+ '|', ["sort", "-k", "6"]);
# (replaces dpkg-deb -c)
# create index file for package with owner IDs instead of names
-pipeline((sub { exec "dpkg-deb", "--fsys-tarfile", $file }),
- (sub { exec "tar", "--numeric-owner", "-tvf", "-" }),
- (sub { exec "sed", "-e", "s/^h/-/" }),
- (sub { exec "sort", "-k", "6" }),
- "$base_dir/index-owner-id") == 0
- or fail();
+spawn({ fail => 'error', out => "$base_dir/index-owner-id" },
+ ["dpkg-deb", "--fsys-tarfile", $file],
+ '|', ["tar", "--numeric-owner", "-tvf", "-"],
+ '|', ["sed", "-e", "s/^h/-/"],
+ '|', ["sort", "-k", "6"]);
# get package control information
my $data = (read_dpkg_control("$base_dir/control/control"))[0];
diff --git a/unpack/unpack-binpkg-l2 b/unpack/unpack-binpkg-l2
index 1b42604..2b04df1 100755
--- a/unpack/unpack-binpkg-l2
+++ b/unpack/unpack-binpkg-l2
@@ -28,7 +28,8 @@ use vars qw($verbose);
my $base_dir = shift;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Pipeline;
+use Lintian::Command qw(spawn);
+use Util;
print "N: Unpacking binary packages in directory $base_dir ...\n" if $verbose;
mkdir("$base_dir/unpacked", 0777) or fail();
@@ -37,24 +38,10 @@ mkdir("$base_dir/unpacked", 0777) or fail();
# improvement on large debs, and factor 1.5 on small debs. I heard
# it's because dpkg-deb syncs while writing. -- Richard
-pipeline((sub { exec 'dpkg-deb', '--fsys-tarfile', "$base_dir/deb" }),
- (sub { exec 'tar', 'xf', '-', '-C', "$base_dir/unpacked" })) == 0
- or fail();
+spawn({ fail => 'error' },
+ ['dpkg-deb', '--fsys-tarfile', "$base_dir/deb"],
+ '|', ['tar', 'xf', '-', '-C', "$base_dir/unpacked"]);
# fix permissions
-spawn('chmod', '-R', 'u+rwX,go-w', "$base_dir/unpacked") == 0 or fail();
-
-exit 0;
-
-# -------------------------------
-
-sub fail {
- if ($_[0]) {
- print STDERR "internal error: $_[0]\n";
- } elsif ($!) {
- print STDERR "internal error: $!\n";
- } else {
- print STDERR "internal error.\n";
- }
- exit 1;
-}
+spawn({ fail => 'error' },
+ ['chmod', '-R', 'u+rwX,go-w', "$base_dir/unpacked"]);
diff --git a/unpack/unpack-srcpkg-l2 b/unpack/unpack-srcpkg-l2
index 7316e6a..9e2c995 100755
--- a/unpack/unpack-srcpkg-l2
+++ b/unpack/unpack-srcpkg-l2
@@ -23,10 +23,10 @@
use strict;
use vars qw($verbose);
-use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Pipeline;
+use Lintian::Command qw(spawn);
+use Util;
($#ARGV == 0) or fail("syntax: unpack-srcpkg-l2 <base-dir>");
my $base_dir = shift;
@@ -34,39 +34,14 @@ my $base_dir = shift;
print "N: Unpacking source package in directory $base_dir ...\n" if $verbose;
chdir($base_dir);
-# We can't use spawn yet because older versions of dpkg-source print things
-# out even with -q. This can be fixed to use spawn once that newer version of
-# dpkg is in oldstable.
-my $pid = fork;
-if (not defined $pid) {
- fail("cannot fork: $!");
-} elsif ($pid == 0) {
- open(STDOUT, '>', '/dev/null');
- exec('dpkg-source', '-q', '-x', 'dsc', 'unpacked');
-} else {
- waitpid($pid, 0);
- unless ($? == 0) {
- fail("cannot run dpkg-source: $!");
- }
-}
+# Ignore STDOUT of the child process because older versions of dpkg-source
+# print things out even with -q.
+spawn({ fail => 'error', out => '/dev/null' },
+ ['dpkg-source', '-q', '-x', 'dsc', 'unpacked']);
# fix permissions
-spawn('chmod', '-R', 'u+rwX,o+rX,o-w', 'unpacked') == 0 or fail();
-
-exit 0;
-
-# -------------------------------
-
-sub fail {
- if ($_[0]) {
- print STDERR "internal error: $_[0]\n";
- } elsif ($!) {
- print STDERR "internal error: $!\n";
- } else {
- print STDERR "internal error.\n";
- }
- exit 1;
-}
+spawn({ fail => 'error' },
+ ['chmod', '-R', 'u+rwX,o+rX,o-w', 'unpacked']);
# Local Variables:
# indent-tabs-mode: nil
--
Debian package checker
Reply to: