[SCM] Debian package checker branch, master, updated. 2.5.1-90-g3238af5
The following commit has been merged in the master branch:
commit 3238af5b869ed2af53623450eef4c0ad5818264b
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jul 13 01:54:18 2011 +0200
Merged udeb and binary packages list formats
The old udeb header is accepted as the bin file, but with the
list-udebpkg gone nothing writes it any more. The list-binpkg script
now has a "-u" parameter to fetch udebs instead of regular debs.
The read_udeb_list sub has been completely replaced by read_bin_list.
diff --git a/debian/changelog b/debian/changelog
index 460a2a5..7ca9d28 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -180,6 +180,10 @@ lintian (2.5.2) UNRELEASED; urgency=low
+ [NT] New files.
* lib/Lintian/{Tag/Info,Tags}.pm:
+ [NT] Updated for profile support.
+ * lib/Read_pkglists.pm:
+ + [NT] Merged the binary and udeb format since they were
+ essentially the same. Old udeb files can still be parsed
+ as binary ones.
* man/lintian.pod.in:
+ [NT] Documented the new --profile option. Note that the
@@ -193,6 +197,12 @@ lintian (2.5.2) UNRELEASED; urgency=low
that these profiles will silently ignore overrides for
"fatal" (non-overridable) tags. (Closes: #536364)
+ * unpack/list-binpkg:
+ + [NT] Added a -u option to make it fetch udebs insteaad of
+ regular binaries. This and the udeb/bin format merge makes
+ list-udebpkg obsolete.
+ * unpack/list-udebpkg:
+ + [NT] Removed in favour of list-binpkg.
* unpack/unpack-srcpkg-l1:
+ [NT] Removed in favour of the collection system.
diff --git a/frontend/lintian b/frontend/lintian
index cff2553..de24546 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -701,6 +701,7 @@ require Lab;
require Util;
require Read_pkglists;
+import Read_pkglists qw(read_bin_list read_src_list);
import Util;
@@ -901,7 +902,7 @@ while (my $arg = shift) {
}
}
if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
- $udeb_info = read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
+ $udeb_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
if ($udeb_info->{$arg}) {
$pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->{$arg}->{'file'});
$found = 1;
@@ -969,7 +970,7 @@ if ($check_everything) {
# make sure package info is available
$src_info = read_src_list("$opt{'LINTIAN_LAB'}/info/source-packages") unless $src_info;
$bin_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/binary-packages") unless $bin_info;
- $udeb_info = read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
+ $udeb_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
debug_msg(2, "pkg_mode = $pkg_mode");
diff --git a/lib/Lab.pm b/lib/Lab.pm
index 7dbc689..62ba094 100644
--- a/lib/Lab.pm
+++ b/lib/Lab.pm
@@ -179,7 +179,7 @@ sub _populate_with_dist {
return 0 unless $ENV{'LINTIAN_DIST'};
return 0 unless $self->{dir};
- debug_msg(2, "spawning list-binpkg, list-udebpkg and list-srcpkg since LINTIAN_DIST=$ENV{'LINTIAN_DIST'}");
+ debug_msg(2, "spawning list-binpkg and list-srcpkg since LINTIAN_DIST=$ENV{'LINTIAN_DIST'}");
my $v = $Lintian::Output::GLOBAL->verbose ? '-v' : '';
my %opts = ( out => $Lintian::Output::GLOBAL->stdout );
@@ -189,8 +189,8 @@ sub _populate_with_dist {
spawn(\%opts, ["$LINTIAN_ROOT/unpack/list-srcpkg",
"$self->{dir}/info/source-packages", $v])
or fail('cannot create source package list');
- spawn(\%opts, ["$LINTIAN_ROOT/unpack/list-udebpkg",
- "$self->{dir}/info/udeb-packages", $v])
+ spawn(\%opts, ["$LINTIAN_ROOT/unpack/list-binpkg",
+ "$self->{dir}/info/udeb-packages", '-u', $v])
or fail('cannot create udeb package list');
return 1;
diff --git a/lib/Read_pkglists.pm b/lib/Read_pkglists.pm
index c318a7e..bed7435 100644
--- a/lib/Read_pkglists.pm
+++ b/lib/Read_pkglists.pm
@@ -29,17 +29,16 @@ use base 'Exporter';
# these banner lines have to be changed with every incompatible change of the
# binary and source list file formats
+## NB: If bumping the BINLIST_FORMAT, remember to kill the UDEB fall back
+## see read_bin_list
use constant BINLIST_FORMAT => "Lintian's list of binary packages in the archive--V4";
use constant SRCLIST_FORMAT => "Lintian's list of source packages in the archive--V4";
-use constant UDEBLIST_FORMAT => "Lintian's list of udeb packages in the archive--V3";
our @EXPORT = (qw(
BINLIST_FORMAT
SRCLIST_FORMAT
- UDEBLIST_FORMAT
read_src_list
read_bin_list
- read_udeb_list
));
sub read_src_list {
@@ -87,6 +86,11 @@ sub read_src_list {
return \%source_info;
}
+# Previously udeb-files had a different format; allow parsing a udeb file as
+# a binary file V4, assuming that is still the binary format at the time.
+my $UDEBLIST_FORMAT = "Lintian's list of udeb packages in the archive--V3";
+
+
sub read_bin_list {
my ($bin_list) = @_;
my %binary_info;
@@ -99,8 +103,12 @@ sub read_bin_list {
my $f;
chop($f = <$IN>);
if ($f ne BINLIST_FORMAT) {
- close($IN);
- croak "$bin_list has an incompatible file format";
+ # accept the UDEB 3 header as alternative to the BIN 4 file
+ if ($f ne $UDEBLIST_FORMAT || BINLIST_FORMAT !~ m/archive--V4$/o) {
+ close($IN);
+ croak "$bin_list has an incompatible file format";
+ }
+ # ok - was an UDEB 3 file, which is a BIN 4 file with a different header
}
# compatible format, so read file
@@ -129,49 +137,6 @@ sub read_bin_list {
return \%binary_info;
}
-sub read_udeb_list {
- my ($udeb_list) = @_;
- my %udeb_info;
-
- return {} unless $udeb_list && -s $udeb_list;
-
- open(my $IN, '<', $udeb_list) or croak("open $udeb_list: $!");
-
- # compatible file format?
- my $f;
- chop($f = <$IN>);
- if ($f ne UDEBLIST_FORMAT) {
- close($IN);
- croak "$udeb_list has an incompatible file format";
- }
-
- # compatible format, so read file
- while (<$IN>) {
- chop;
-
- next if m/^\s*$/o;
- my ($udeb,$ver,$source,$source_ver,$file,$timestamp,$area) = split(m/\;/o,$_);
-
- my $udeb_struct;
- %$udeb_struct =
- (
- 'package' => $udeb,
- 'version' => $ver,
- 'source' => $source,
- 'source-version' => $source_ver,
- 'file' => $file,
- 'timestamp' => $timestamp,
- 'area' => $area,
- );
-
- $udeb_info{$udeb} = $udeb_struct;
- }
-
- close($IN);
- return \%udeb_info;
-}
-
-
1;
# Local Variables:
diff --git a/reporting/harness b/reporting/harness
index 191d9dd..96a76f2 100755
--- a/reporting/harness
+++ b/reporting/harness
@@ -166,7 +166,7 @@ if ($opt_i) { # process changes only
# read udeb packages files
$pkgfile = "$LINTIAN_LAB/info/udeb-packages";
(-f $pkgfile) or Die("cannot find list of udeb packages $pkgfile");
- my %udeb_info = %{ read_udeb_list($pkgfile) };
+ my %udeb_info = %{ read_bin_list($pkgfile) };
# read source packages files
$pkgfile = "$LINTIAN_LAB/info/source-packages";
diff --git a/reporting/html_reports b/reporting/html_reports
index 9faed73..151bffa 100755
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@ -115,7 +115,7 @@ for my $template (qw/head foot clean index maintainer maintainers packages tag
#
my %binary_info = %{ read_bin_list("$LINTIAN_LAB/info/binary-packages"); };
-my %udeb_info = %{ read_udeb_list("$LINTIAN_LAB/info/udeb-packages"); };
+my %udeb_info = %{ read_bin_list("$LINTIAN_LAB/info/udeb-packages"); };
my %source_info = %{ read_src_list("$LINTIAN_LAB/info/source-packages"); };
my %bin_src_ref;
diff --git a/unpack/list-binpkg b/unpack/list-binpkg
index 79290ee..dcf216f 100755
--- a/unpack/list-binpkg
+++ b/unpack/list-binpkg
@@ -33,16 +33,20 @@ if ($#ARGV == -1) {
print "list-binpkg [-v] <output-list-file>\n";
print "options:\n";
print " -v verbose\n";
+ print " -u Fetch udebs\n";
exit 0;
}
my $verbose = 0;
+my $udeb = 0;
my $output_file = undef;
while (my $arg = shift) {
if ($arg =~ s,^-,,o) {
if ($arg eq 'v') {
$verbose = 1;
+ } elsif ($arg eq 'u') {
+ $udeb = 1;
} else {
print STDERR "error: unknown command line argument: $arg\n";
exit 1;
@@ -95,11 +99,18 @@ print OUT Read_pkglists::BINLIST_FORMAT. "\n";
my @packages_files;
foreach my $area (split /\s*,\s*/,$LINTIAN_AREA) {
my %hash;
+ my $file;
$hash{'dist'} = $LINTIAN_DIST;
$hash{'arch'} = $LINTIAN_ARCH;
$hash{'area'} = $area;
- $hash{'file'} = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- "binary-$hash{'arch'}/Packages";
+ if ($udeb) {
+ $file = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
+ "debian-installer/binary-$hash{'arch'}/Packages";
+ } else {
+ $file = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
+ "binary-$hash{'arch'}/Packages";
+ }
+ $hash{'file'} = $file;
push @packages_files, \%hash;
}
diff --git a/unpack/list-udebpkg b/unpack/list-udebpkg
deleted file mode 100755
index dcb97fd..0000000
--- a/unpack/list-udebpkg
+++ /dev/null
@@ -1,242 +0,0 @@
-#!/usr/bin/perl -w
-# list-udebpkg -- lintian helper script
-
-# Copyright (C) 1998 Christian Schwarz
-# Copyright (C) 2004 Frank Lichtenheld
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, you can find it on the World Wide
-# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
-# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-# MA 02110-1301, USA.
-
-use strict;
-use warnings;
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Relation::Version qw(versions_lte);
-
-# turn file buffering off:
-$| = 1;
-
-# parse command line options
-if ($#ARGV == -1) {
- print "list-udebpkg [-v] <output-list-file>\n";
- print "options:\n";
- print " -v verbose\n";
- exit 0;
-}
-
-my $verbose = 0;
-my $output_file = undef;
-
-while (my $arg = shift) {
- if ($arg =~ s,^-,,o) {
- if ($arg eq 'v') {
- $verbose = 1;
- } else {
- print STDERR "error: unknown command line argument: $arg\n";
- exit 1;
- }
- } else {
- if ($output_file) {
- print STDERR "error: too many command line arguments: $arg\n";
- exit 1;
- }
- $output_file = $arg;
- }
-}
-
-unless ($output_file) {
- print STDERR "error: no output file specified\n";
- exit 1;
-}
-
-# import perl libraries
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Read_pkglists;
-use Util;
-
-# get variables out of environment
-my $LINTIAN_ARCHIVEDIR = $ENV{'LINTIAN_ARCHIVEDIR'};
-my $LINTIAN_DIST = $ENV{'LINTIAN_DIST'};
-my $LINTIAN_ARCH = $ENV{'LINTIAN_ARCH'};
-my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
-my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-
-# read old list file (this command does nothing if the file does not exist)
-my $ref = {};
-# ignore the contents if the contents cannot be read - that is what we
-# used to do!
-eval { $ref = read_udeb_list($output_file) };
-my %udeb_info = %$ref;
-
-my %pkgfile;
-# map filenames to package names
-for my $pkg (keys %udeb_info) {
- $pkgfile{$udeb_info{$pkg}->{'file'}} = $pkg;
-}
-
-# open output file
-open(OUT, '>', $output_file)
- or fail("cannot open list file $output_file for writing: $!");
-print OUT Read_pkglists::UDEBLIST_FORMAT . "\n";
-
-# parse Packages file to get list of packages
-my @packages_files;
-foreach my $area (split /\s*,\s*/,$LINTIAN_AREA) {
- my %hash;
- $hash{'dist'} = $LINTIAN_DIST;
- $hash{'arch'} = $LINTIAN_ARCH;
- $hash{'area'} = $area;
- $hash{'file'} = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- "debian-installer/binary-$hash{'arch'}/Packages";
- push @packages_files, \%hash;
-}
-
-my %packages;
-my $total = 0;
-
-foreach my $packages_file (@packages_files) {
- my $pkgs_file = $packages_file->{'file'};
- if (-e $pkgs_file) {
- print "N: Parsing $pkgs_file ...\n" if $verbose;
- open(IN, '<', $pkgs_file)
- or fail("cannot open Packages file $pkgs_file: $!");
- } elsif (-e "$pkgs_file.gz") {
- print "N: Parsing $pkgs_file.gz ...\n" if $verbose;
- open(IN, '-|', 'gzip', '-dc', "$pkgs_file.gz")
- or fail("cannot open Packages file $pkgs_file.gz: $!");
- } else {
- warn("No packages file $pkgs_file, skipping");
- next;
- }
-
- my $line;
-
- while (!eof(IN)) {
- do { $line = <IN> } until ($line =~ m/^Architecture: (.*)$/m);
- my $arch = $1;
- do { $line = <IN> } until ($line =~ m/^Filename: (.*)$/m);
- my $deb_file = $1;
- do { $line = <IN> } until ($line =~ m/^\s*$/m);
-
- my @stat;
- # get timestamp...
- unless (@stat = stat "$LINTIAN_ARCHIVEDIR/$deb_file") {
- print "E: general: cannot stat $LINTIAN_ARCHIVEDIR/$deb_file\n";
- next;
- }
- my $timestamp = $stat[9];
- my ($status, $pkg, $data);
-
- # was package already included in last list?
- if (exists $pkgfile{$deb_file}) {
- # yes!
- $pkg = $pkgfile{$deb_file};
- $data = $udeb_info{$pkg};
-
- # file changed since last run?
- if ($timestamp == $data->{'timestamp'}) {
- # no.
- $status = 'unchanged';
- } else {
- $status = 'changed';
- delete $udeb_info{$pkg};
- }
- } else {
- # new package, get info
- $status = 'new';
- }
-
- if (($status eq 'new') or ($status eq 'changed')) {
- $data = &safe_get_deb_info($deb_file);
- next if not defined $data;
- $pkg = $data->{'package'};
- }
-
- # Check for duplicates. In the case of a duplicate, we take the one
- # with the latest version.
- if (exists $packages{$pkg}) {
- if (versions_lte($data->{version}, $packages{$pkg}{version})) {
- next;
- }
- }
-
- unless (exists $data->{'source-version'}) {
- if ($data->{'source'} =~ /^([-+\.\w]+)\s+\((.+)\)$/) {
- $data->{'source'} = $1;
- $data->{'source-version'} = $2;
- } else {
- $data->{'source-version'} = $data->{'version'};
- }
- }
-
- # Save entry for writing to output file.
- $data->{file} = $deb_file;
- $data->{timestamp} = $timestamp;
- $data->{area} = $packages_file->{area};
- $data->{status} = $status;
- $packages{$pkg} = $data;
-
- # remove record from hash
- delete $udeb_info{$pkg} if $status eq 'unchanged';
- $total++;
- }
- close(IN) or fail("cannot close input pipe: $!");
-}
-for my $pkg (sort keys %packages) {
- print OUT join(';',
- $pkg,
- $packages{$pkg}{version},
- $packages{$pkg}{source},
- $packages{$pkg}{'source-version'},
- $packages{$pkg}{file},
- $packages{$pkg}{timestamp},
- $packages{$pkg}{area}
- ),"\n";
- printf "N: Listed %s udeb package %s %s\n", $packages{$pkg}{status},
- $pkg, $packages{$pkg}{version} if $verbose;
-}
-close(OUT) or fail("cannot close output pipe: $!");
-if ($verbose) {
- # All packages that are still included in %udeb_info have disappeared from
- # the archive.
- for my $pkg (sort keys %udeb_info) {
- print "N: Removed udeb package $pkg from list\n";
- }
- printf "N: Listed %d udeb packages\n",$total;
-}
-
-exit 0;
-
-sub safe_get_deb_info {
- # use eval when calling get_deb_info, since we don't want to `die' just
- # because of a single broken package
- my $data;
- eval { $data = get_deb_info("$LINTIAN_ARCHIVEDIR/$_[0]"); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-udeb-package $_[0]\n";
- return;
- }
- $data->{'source'} or ($data->{'source'} = $data->{'package'});
- return $data;
-}
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 4
-# End:
-# vim: syntax=perl sw=4 ts=4 et shiftround
--
Debian package checker
Reply to: