[SCM] Debian package checker branch, master, updated. 2.5.2-23-g6e98423
The following commit has been merged in the master branch:
commit 6e9842343ba7d47e81a59364af26bbbf6baccc34
Author: Niels Thykier <niels@thykier.net>
Date: Tue Aug 16 18:09:05 2011 +0200
Replace coll/source-control-file with smarter L::C::Source
Lintian::Collect::Source will now load debfiles/control if needed
to handle the methods binaries and binary_field. This makes
source-control-file redundant and it has been reduced to a simple
"clean up" wrapper to remove 'control/'.
diff --git a/checks/debhelper b/checks/debhelper
index c01e6ae..f1ecb63 100644
--- a/checks/debhelper
+++ b/checks/debhelper
@@ -188,10 +188,10 @@ for my $binpkg (keys %$pkgs) {
my ($weak_depends, $strong_depends, $depends) = ('','','');
foreach my $field (qw(pre-depends depends)) {
- $strong_depends .= $info->binary_field($binpkg, $field);
+ $strong_depends .= ($info->binary_field($binpkg, $field)//'');
}
foreach my $field (qw(recommends suggests)) {
- $weak_depends .= $info->binary_field($binpkg, $field);
+ $weak_depends .= ($info->binary_field($binpkg, $field)//'');
}
$depends = $weak_depends . $strong_depends;
diff --git a/checks/debhelper.desc b/checks/debhelper.desc
index 0176837..480a40f 100644
--- a/checks/debhelper.desc
+++ b/checks/debhelper.desc
@@ -3,7 +3,7 @@ Author: Joey Hess <joeyh@debian.org>
Abbrev: dh
Type: source
Info: This looks for common mistakes in debhelper source packages.
-Needs-Info: debfiles, source-control-file
+Needs-Info: debfiles
Tag: maintainer-script-lacks-debhelper-token
Severity: normal
diff --git a/checks/fields b/checks/fields
index 9f29885..a9392dd 100644
--- a/checks/fields
+++ b/checks/fields
@@ -731,7 +731,7 @@ if ($type eq 'source') {
my $arch_indep_packages = 0;
my $arch_dep_packages = 0;
foreach my $binpkg (keys %$binpkgs) {
- my $arch = $info->binary_field($binpkg, 'architecture');
+ my $arch = $info->binary_field($binpkg, 'architecture')//'';
if ($arch eq 'all') {
$arch_indep_packages++;
} else {
@@ -840,13 +840,13 @@ if ($type eq 'source') {
foreach my $binpkg (keys %$binpkgs) {
if ($binpkg =~ m/-dbg$/) {
push @dbg_pkgs, $binpkg;
- } elsif ($info->binary_field($binpkg, 'architecture') ne 'all') {
+ } elsif (($info->binary_field($binpkg, 'architecture')//'') ne 'all') {
push @arch_dep_pkgs, $binpkg;
}
}
foreach (@dbg_pkgs) {
my $deps;
- $deps = $info->binary_field($_, 'pre-depends') . ', ';
+ $deps = ($info->binary_field($_, 'pre-depends')//'') . ', ';
$deps .= $info->binary_field($_, 'depends');
tag 'dbg-package-missing-depends', $_
unless (grep {my $quoted_name = qr<\Q$_>; $deps =~ m/(?:\s|,|^)$quoted_name(?:\s|,|\z)/} @arch_dep_pkgs);
diff --git a/checks/fields.desc b/checks/fields.desc
index 82c83e2..ca138bf 100644
--- a/checks/fields.desc
+++ b/checks/fields.desc
@@ -2,7 +2,7 @@ Check-Script: fields
Author: Marc 'HE' Brockschmidt <marc@marcbrockschmidt.de>
Abbrev: fld
Type: binary, udeb, source
-Needs-Info: debfiles, source-control-file, index
+Needs-Info: debfiles, index
Info: This script checks the syntax of the fields in package control files,
as described in the Policy Manual.
diff --git a/checks/rules.desc b/checks/rules.desc
index 19e3529..034399f 100644
--- a/checks/rules.desc
+++ b/checks/rules.desc
@@ -1,7 +1,7 @@
Check-Script: rules
Author: Russ Allbery <rra@debian.org>
Type: source
-Needs-Info: debfiles, source-control-file
+Needs-Info: debfiles
Info: Check targets and actions in debian/rules.
Abbrev: rul
diff --git a/checks/standards-version.desc b/checks/standards-version.desc
index 1c9beed..75be8a8 100644
--- a/checks/standards-version.desc
+++ b/checks/standards-version.desc
@@ -4,7 +4,7 @@ Abbrev: std
Type: source
Info: This script checks if a source package contains a valid
Standards-Version field.
-Needs-Info: debfiles, source-control-file
+Needs-Info: debfiles
Tag: no-standards-version-field
Severity: important
diff --git a/checks/version-substvars b/checks/version-substvars
index 195b6c7..a89a9d1 100644
--- a/checks/version-substvars
+++ b/checks/version-substvars
@@ -53,7 +53,7 @@ foreach (keys %$binpkgs) {
my ($pkg1, $pkg1_is_any, $pkg2, $pkg2_is_any, $substvar_strips_binNMU);
$pkg1 = $_;
- $pkg1_is_any = ($info->binary_field($pkg1, 'architecture') ne 'all');
+ $pkg1_is_any = (($info->binary_field($pkg1, 'architecture')//'') ne 'all');
foreach my $field (@dep_fields) {
next unless $info->binary_field($pkg1, $field);
@@ -62,8 +62,8 @@ foreach (keys %$binpkgs) {
}
}
- foreach (split(m/,/, $info->binary_field($pkg1, 'pre-depends').', '.
- $info->binary_field($pkg1, 'depends'))) {
+ foreach (split(m/,/, ($info->binary_field($pkg1, 'pre-depends')//'').', '.
+ ($info->binary_field($pkg1, 'depends')//''))) {
next unless m/(\S+)\s*\(\s*=\s*\${((?:Source-|source:|binary:)Version)}/x;
$pkg2 = $1;
@@ -77,7 +77,7 @@ foreach (keys %$binpkgs) {
unless ($pkg2 =~ /\$\{\S+\}/);
next;
}
- $pkg2_is_any = ($info->binary_field($pkg2, 'architecture') ne 'all');
+ $pkg2_is_any = (($info->binary_field($pkg2, 'architecture')//'') ne 'all');
if ($pkg1_is_any) {
if ($pkg2_is_any and $substvar_strips_binNMU) {
diff --git a/checks/version-substvars.desc b/checks/version-substvars.desc
index 8d5fa5e..5fcba0f 100644
--- a/checks/version-substvars.desc
+++ b/checks/version-substvars.desc
@@ -2,7 +2,7 @@ Check-Script: version-substvars
Author: Adeodato Simó <dato@net.com.org.es>
Abbrev: v-s
Type: source
-Needs-Info: debfiles, source-control-file
+Needs-Info: debfiles
Info: This script checks for correct use of the various
<tt>*Version</tt> substvars, e.g. deprecated substvars,
or usage that can cause un-binNMUability
diff --git a/collection/source-control-file b/collection/source-control-file
index b71d3bc..df6aec9 100755
--- a/collection/source-control-file
+++ b/collection/source-control-file
@@ -25,33 +25,9 @@ use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail('syntax: source-control-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
-
--f 'debfiles/control' or fail('control invoked in wrong directory');
-
-my @control_data = read_dpkg_control('debfiles/control');
-shift @control_data; # we don't need the source information
-
-delete_dir('control');
-mkdir 'control', 0777 or fail( "can't create dir control: $!" );
-
-foreach (@control_data) {
- my $pkg_name = $_->{'package'};
- fail("no package line found in control file of $pkg $type")
- if !$pkg_name;
- mkdir "control/$pkg_name", 0777
- or fail( "can't create dir control/$pkg_name: $!" );
- for my $field (keys %$_) {
- my $value = $_->{$field};
- # checks/fields will convert colons into slashes
- $field =~ s,/,:,g;
-
- my $field_file = "control/$pkg_name/$field";
- open (F, '>', $field_file)
- or fail("cannot open file $field_file for writing: $!");
- print F $value,"\n";
- close F or fail("cannot write control/$pkg_name/$field: $!");
+if ( -d 'control/' ) {
+ my $r = system('rm', '-r', 'control/');
+ if ($r) {
+ die "system: rm -r control/ died with: " . (($r >> 8) & 0xff) . ".\n";
}
}
diff --git a/collection/source-control-file.desc b/collection/source-control-file.desc
index 9260a55..27ce1c3 100644
--- a/collection/source-control-file.desc
+++ b/collection/source-control-file.desc
@@ -1,6 +1,9 @@
Collector-Script: source-control-file
Author: Frank Lichtenheld <djpig@debian.org>
Info: Collects information about binary packages from debian/control in source packages
+ .
+ This is deprecated and does nothing (but clean up). Checks should migrate to
+ Lintian::Collect::Source::{binaries,binary_field}.
Type: source
Version: 1
-Needs-Info: debfiles
+Auto-Remove: yes
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index 98616e0..44e7512 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -23,6 +23,8 @@ use strict;
use warnings;
use base 'Lintian::Collect::Package';
+use Cwd();
+
use Lintian::Relation;
use Parse::DebianChangelog;
@@ -91,19 +93,19 @@ sub native {
# Returns a hash of binaries to the package type, assuming a type of deb
# unless the package type field is present.
+# sub binaries Needs-Info debfiles
sub binaries {
my ($self) = @_;
return $self->{binaries} if exists $self->{binaries};
+ # we need the binary fields for this.
+ $self->_load_binary_fields unless exists $self->{binary_field};
+
my %binaries;
- my $base_dir = $self->base_dir();
- # sub binaries Needs-Info source-control-file
- opendir(BINPKGS, "$base_dir/control") or fail("can't open control directory: $!");
- for my $package (readdir BINPKGS) {
- next if $package =~ /^\.\.?$/;
- my $type = $self->binary_field($package, 'xc-package-type') || 'deb';
- $binaries{$package} = lc $type;
+ foreach my $pkg (keys %{ $self->{binary_field} } ) {
+ my $type = $self->binary_field($pkg, 'xc-package-type') || 'deb';
+ $binaries{$pkg} = lc $type;
}
- closedir BINPKGS;
+
$self->{binaries} = \%binaries;
return $self->{binaries};
}
@@ -111,19 +113,58 @@ sub binaries {
# Returns the value of a control field for a binary package or the empty
# string if that control field isn't present. This does not implement
# inheritance from the settings in the source stanza.
+# sub binary_field Needs-Info debfiles
sub binary_field {
my ($self, $package, $field) = @_;
+ $self->_load_binary_fields unless exists $self->{binary_field};
+
+ # Check if the package actually exists, otherwise it may create an
+ # empty entry for it.
return $self->{binary_field}{$package}{$field}
- if exists $self->{binary_field}{$package}{$field};
- my $value = '';
- my $base_dir = $self->base_dir();
- # sub binary_field Needs-Info source-control-file
- if (-f "$base_dir/control/$package/$field") {
- $value = slurp_entire_file("$base_dir/control/$package/$field");
- chomp $value;
+ if exists $self->{binary_field}{$package};
+
+ return;
+}
+
+# Internal method to load binary fields from debfiles/control
+# sub _load_binary_fields Needs-Info debfiles
+sub _load_binary_fields {
+ my ($self) = @_;
+ # Load the fields from d/control
+ my $dctrl = $self->debfiles('control');
+ my $ok = 0;
+ if ( -l $dctrl ) {
+ # hmmm - this smells of trouble...
+ if ( -e $dctrl ) {
+ # it exists, but what does it point to?
+ my $droot = Cwd::abs_path($self->debfiles);
+ my $target = Cwd::abs_path($dctrl);
+ if ($droot && $target && $target =~ m,^$droot/,) {
+ # does not escape $droot, so it could work.
+ $ok = 1;
+ }
+ }
+ } else {
+ $ok = 1 if -e $dctrl;
+ }
+
+ unless ($ok) {
+ # Bad file, assume the package and field does not exist.
+ $self->{binary_field} = {};
+ return;
}
- $self->{binary_field}{$package}{$field} = $value;
- return $self->{binary_field}{$package}{$field};
+ my @control_data = read_dpkg_control($dctrl);
+ my %packages;
+
+ shift @control_data; # throw away the source part
+
+ foreach my $binary (@control_data) {
+ my $pkg = $binary->{'package'};
+ $packages{$pkg} = $binary;
+ }
+ $self->{binary_field} = \%packages;
+
+ return 1;
}
# Return a Lintian::Relation object for the given relationship field in a
--
Debian package checker
Reply to: