+++ /dev/null
-# fields -- lintian check script (rewrite) -*- perl -*-
-#
-# Copyright (C) 2004 Marc Brockschmidt
-#
-# Parts of the code were taken from the old check script, which
-# was Copyright (C) 1998 Richard Braakman (also licensed under the
-# GPL 2 or higher)
-#
-# 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.
-
-package Lintian::fields;
-use strict;
-
-use lib "$ENV{'LINTIAN_ROOT'}/checks/";
-use common_data;
-use Dep;
-use Tags;
-use Util;
-use Lintian::Data;
-
-# The allowed Python dependencies currently. This is the list of alternatives
-# that, either directly or through transitive dependencies that can be relied
-# upon, ensure /usr/bin/python will exist for the use of dh_python.
-my $python_depend = 'python | python-dev | python-all | python-all-dev | '
- . join (' | ', map { "python$_ | python$_-dev" } qw(2.4 2.5));
-
-# Certain build tools must be listed in Build-Depends even if there are no
-# arch-specific packages because they're required in order to run the clean
-# rule. (See Policy 7.6.) The following is a list of package dependencies;
-# regular expressions that, if they match anywhere in the debian/rules file,
-# say that this package is allowed (and required) in Build-Depends; and
-# optional tags to use for reporting the problem if some information other
-# than the default is required.
-my @global_clean_depends = (
- [ ant => '^include\s*/usr/share/cdbs/1/rules/ant.mk' ],
- [ cdbs => '^include\s+/usr/share/cdbs/' ],
- [ dbs => '^include\s+/usr/share/dbs/' ],
- [ debhelper => '^include\s+/usr/share/cdbs/1/rules/debhelper.mk' ],
- [ dpatch => '^include\s+/usr/share/cdbs/1/rules/dpatch.mk' ],
- [ quilt => '^include\s+/usr/share/cdbs/1/rules/patchsys-quilt.mk' ],
- [ dpatch => '^include\s+/usr/share/dpatch/' ],
- [ quilt => '^include\s+/usr/share/quilt/' ],
- [ $python_depend => '/usr/share/cdbs/1/class/python-distutils.mk', 'missing-python-build-dependency' ],
-);
-
-# These are similar, but the resulting dependency is only allowed, not
-# required.
-#
-# The xsfclean rule is specific to the packages maintained by the X Strike
-# Force, but there are enough of those to make the rule worthwhile.
-my @global_clean_allowed = (
- [ patchutils => '^include\s+/usr/share/cdbs/1/rules/dpatch.mk' ],
- [ patchutils => '^include\s+/usr/share/cdbs/1/rules/patchsys-quilt.mk' ],
- [ patchutils => '^include\s+/usr/share/cdbs/1/rules/simple-patchsys.mk' ],
- [ 'python-central' => '^DEB_PYTHON_SYSTEM\s*:?=\s*pycentral' ],
- [ 'python-support' => '^DEB_PYTHON_SYSTEM\s*:?=\s*pysupport' ],
- [ 'python-setuptools' => '/usr/share/cdbs/1/class/python-distutils.mk' ],
- [ quilt => '^clean:\s+xsfclean\b' ],
-);
-
-# A list of packages; regular expressions that, if they match anywhere in the
-# debian/rules file, this package must be listed in either Build-Depends or
-# Build-Depends-Indep as appropriate; and optional tags as above.
-my @global_depends = (
- [ $python_depend => '^\t\s*dh_python\s', 'missing-dh_python-build-dependency' ],
- [ 'python-central' => '^\t\s*dh_pycentral\s' ],
- [ 'python-support' => '^\t\s*dh_pysupport\s' ],
- [ 'python-central' => '^DEB_PYTHON_SYSTEM\s*:?=\s*pycentral' ],
- [ 'python-support' => '^DEB_PYTHON_SYSTEM\s*:?=\s*pysupport' ],
-);
-
-# Similarly, this list of packages, regexes, and optional tags say that if the
-# regex matches in one of clean, build-arch, binary-arch, or a rule they
-# depend on, this package is allowed (and required) in Build-Depends.
-my @rule_clean_depends = (
- [ debhelper => '^\t\s*dh_.+' ],
- [ dpatch => '^\t\s*dpatch\s' ],
- [ 'libmodule-build-perl' => '(^\t|\|\|)\s*(perl|\$\(PERL\))\s+Build\b' ],
- [ "po-debconf" => '^\t\s*debconf-updatepo\s' ],
- [ $python_depend => '^\t\s*python\s', 'missing-python-build-dependency' ],
- [ $python_depend => '\ssetup\.py\b', 'missing-python-build-dependency' ],
- [ quilt => '^\t\s*(\S+=\S+\s+)*quilt\s' ],
- [ yada => '^\t\s*yada\s' ],
-);
-
-# Similar, but the resulting dependency is only allowed, not required. We
-# permit a versioned dependency on perl-base because that used to be the
-# standard suggested dependency. No package should be depending on just
-# perl-base, since it's Priority: required.
-my @rule_clean_allowed = (
- [ patch => '^\t\s*(?:perl debian/)?yada\s+unpatch' ],
- [ 'perl | perl-base (>= 5.6.0-16)' => '(^\t|\|\|)\s*(perl|\$\(PERL\))\s' ],
- [ 'python-setuptools' => '\ssetup\.py\b' ],
-);
-
-# A simple list of regular expressions which, if they match anywhere in
-# debian/rules, indicate the requirements for debian/rules clean are complex
-# enough that we can't know what packages are permitted in Build-Depends and
-# should bypass the build-depends-without-arch-dep check completely.
-my @global_clean_bypass = (
- '^include\s*/usr/share/cdbs/1/class/ant.mk',
- '^\s+dh\s+'
-);
-
-sub run {
-
-my $pkg = shift;
-my $type = shift;
-my $version;
-my $arch_indep;
-
-# Load obsolete packages list.
-my $obsolete_packages = Lintian::Data->new ('fields/obsolete-packages');
-
-local $/ = undef; #Read everything in one go
-
-unless (-d "fields") {
- fail("directory in lintian laboratory for $type package $pkg missing: fields");
-}
-
-#---- Package
-
-if ($type eq "binary"){
- if (not open (FH, '<', "fields/package")) {
- tag "no-package-name", "";
- } else {
- my $name = <FH>;
- close FH;
-
- unfold("package", \$name);
- tag "bad-package-name", "" unless $name =~ /^[A-Z0-9][-+\.A-Z0-9]+$/i;
- tag "package-not-lowercase", "" if ($name =~ /[A-Z]/)
- }
-}
-
-#---- Version
-
-if (not open (FH, '<', "fields/version")) {
- tag "no-version-field", "";
-} else {
- $version = <FH>;
- close FH;
-
- unfold("version", \$version);
-
- if (@_ = _valid_version($version)) {
- my ($epoch, $upstream, $debian) = @_;
- if ($upstream !~ /^\d/i) {
- tag "upstream-version-not-numeric", "$version";
- }
- if (defined $debian) {
- tag "debian-revision-should-not-be-zero", "$version"
- if $debian eq '-0';
- my $ubuntu;
- $debian =~ /^-([^.]+)(?:\.[^.]+)?(?:\.[^.]+)?(\..*)?$/;
- my $extra = $2;
- if (defined $extra) {
- $debian =~ /^-([^.]+ubuntu[^.]+)(?:\.\d+){1,3}(\..*)?$/;
- $ubuntu = 1;
- $extra = $2;
- }
- if (not defined $1 or defined $extra) {
- tag "debian-revision-not-well-formed", "$version";
- }
- if ($debian =~ /^-[^.-]+\.[^.-]+\./ and not $ubuntu) {
- tag "binary-nmu-uses-old-version-style", "$version"
- if $type eq 'binary';
- tag "binary-nmu-debian-revision-in-source", "$version"
- if $type eq 'source';
- }
- }
- if ($version =~ /\+b\d+$/ && $type eq "source") {
- tag "binary-nmu-debian-revision-in-source", "$version";
- }
- } else {
- tag "bad-version-number", "$version";
- }
-}
-
-#---- Architecture
-
-if (not open (FH, '<', "fields/architecture")) {
- tag "no-architecture-field", "";
-} else {
- my $archs = <FH>;
- close FH;
-
- unfold("architecture", \$archs);
-
- my @archs = split / /, $archs;
-
- if (@archs > 1 && grep { $_ eq "any" || $_ eq "all" } @archs) {
- tag "magic-arch-in-arch-list", "";
- }
-
- for my $arch (@archs) {
- tag "unknown-architecture", "$arch" unless $known_archs{$arch};
- }
-
- if ($type eq "binary") {
- tag "too-many-architectures", "" if (@archs > 1);
- tag "arch-any-in-binary-pkg", "" if (grep { $_ eq "any" } @archs);
- tag "aspell-package-not-arch-all", ""
- if ($pkg =~ /^aspell-[a-z]{2}(-.*)?$/ && (@archs > 1 || $archs[0] ne 'all'));
- }
-
- # Used for later tests.
- $arch_indep = 1 if (@archs == 1 && $archs[0] eq 'all');
-}
-
-#---- Subarchitecture (udeb)
-
-if (open(FH, '<', "fields/subarchitecture")) {
- my $subarch = <FH>;
- close(FH);
-
- unfold("subarchitecture", \$subarch);
-}
-
-#---- Maintainer
-#---- Uploaders
-
-for my $f (qw(maintainer uploaders)) {
- if (not open (FH, '<', "fields/$f")) {
- tag "no-maintainer-field", "" if $f eq "maintainer";
- } else {
- my $maintainer = <FH>;
- close FH;
-
- # Note, not expected to hit on uploaders anymore, as dpkg now strips
- # newlines for the .dsc, and the newlines don't hurt in debian/control
- unfold($f, \$maintainer);
-
- $maintainer =~ s/^\s*(.+?)\s*$/$1/; #Remove leading and trailing whitespace
-
- if ($f eq "uploaders") {
- check_maint($_, "uploader") for (split /\s*,\s*/, $maintainer);
- } else {
- check_maint($maintainer, $f);
- if ($type eq 'source'
- && $maintainer =~ /\@lists(\.alioth)?\.debian\.org\b/
- && ! -f 'fields/uploaders') {
- tag 'no-human-maintainers';
- }
- }
- }
-}
-
-#---- Source
-
-if ($type eq "source") {
- if (not open (FH, '<', "fields/source")) {
- tag "no-source-field", "";
- } else {
- my $source = <FH>;
- close FH;
-
- unfold("source", \$source);
-
- if ($type eq 'source') {
- if ($source ne $pkg) {
- tag "source-field-does-not-match-pkg-name", "$_";
- }
- } else {
- if ($source !~ /[A-Z0-9][-+\.A-Z0-9]+ #Package name
- \s*
- (?:\((?:\d+:)?(?:[-\.+:A-Z0-9]+?)(?:-[\.+A-Z0-9]+)?\))?\s*$/ix) { #Version
- tag "source-field-malformed", "$source";
- }
- }
- }
-}
-
-#---- Essential
-
-if (open (FH, '<', "fields/essential")) {
- my $essential = <FH>;
- close FH;
-
- unfold("essential", \$essential);
-
- tag "essential-in-source-package", "" if ($type eq "source");
- tag "essential-no-not-needed", "" if ($essential eq "no");
- tag "unknown-essential-value", "" if ($essential ne "no" and $essential ne "yes");
- tag "new-essential-package", "" if ($essential eq "yes" and ! $known_essential{$pkg});
-}
-
-#---- Section
-
-if (not open (FH, '<', "fields/section")) {
- tag 'no-section-field' if ($type eq 'binary');
-} else {
- my $section = <FH>;
- close FH;
-
- unfold("section", \$section);
-
- if ($type eq 'udeb') {
- unless ($section eq 'debian-installer') {
- tag "wrong-section-for-udeb", "$section";
- }
- } else {
- my @parts = split /\//, $section, 2;
-
- if ($parts[0] =~ /non-US/i) {
- tag "non-us-spelling", "" if ($parts[0] ne "non-US");
- if ($parts[1] and not $known_non_us_parts{$parts[1]}) {
- tag "unknown-section", "$section";
- }
- } elsif (scalar @parts > 1) {
- tag "unknown-section", "$section" unless $known_archive_parts{$parts[0]};
- tag "unknown-section", "$section" unless $known_sections{$parts[1]};
- } elsif ($parts[0] eq 'unknown') {
- tag "section-is-dh_make-template";
- } else {
- tag "unknown-section", "$section" unless $known_sections{$parts[0]};
- }
-
- # Check package name <-> section.
- if ($pkg =~ /-docs?$/) {
- tag "doc-package-should-be-section-doc", $pkg
- unless $parts[-1] eq 'doc';
- } elsif ($pkg =~ /^lib.*-perl$/) {
- tag "perl-package-should-be-section-perl", $pkg
- unless $parts[-1] eq 'perl';
- } elsif ($pkg =~ /^python-/) {
- tag "python-package-should-be-section-python", $pkg
- unless $parts[-1] eq 'python';
- } elsif ($pkg =~ /^lib.*-dev$/) {
- tag "dev-package-should-be-section-libdevel", $pkg
- unless $parts[-1] eq 'libdevel';
- }
- }
-}
-
-#---- Priority
-
-if (not open (FH, '<', "fields/priority")) {
- tag "no-priority-field", "" if $type eq "binary";
-} else {
- my $priority = <FH>;
- close FH;
-
- unfold("priority", \$priority);
-
- tag "unknown-priority", "$priority" if (! $known_prios{$priority});
-
- if ($pkg =~ /-dbg$/) {
- tag "debug-package-should-be-priority-extra", $pkg
- unless $priority eq 'extra';
- }
-}
-
-#---- Standards-Version
-# handled in checks/standards-version
-
-#---- Description
-# handled in checks/description
-
-#--- Homepage
-
-if (open (FH, '<', "fields/homepage")) {
- my $homepage = <FH>;
- close(FH);
-
- unfold("homepage", \$homepage);
-
- if ($homepage =~ /^\s*<(?:UR[LI]:)?.*>\s*$/i) {
- tag "superfluous-clutter-in-homepage", $homepage;
- }
-
- require URI;
- my $uri = URI->new($homepage);
-
- unless ($uri->scheme) { # not an absolute URI
- tag "bad-homepage", $homepage;
- }
-}
-
-#---- Installer-Menu-Item (udeb)
-
-if (open(FH, '<', "fields/installer-menu-item")) {
- my $menu_item = <FH>;
- close(FH);
-
- unfold('installer-menu-item', \$menu_item);
-
- $menu_item =~ /^\d+$/ or tag "bad-menu-item", "$menu_item";
-}
-
-
-#---- Package relations (binary package)
-
-# Check whether the package looks like a meta-package, used for later
-# dependency checks. We consider a package to possibly be a meta-package if
-# it is a binary package, arch: all, with no files outside of /usr/share/doc.
-my $metapackage = 0;
-if ($type eq 'binary' && $arch_indep) {
- $metapackage = 1;
- open (IN, '<', "index") or fail("cannot open index file index: $!");
- local $_;
- local $/ = "\n";
- while (<IN>) {
- my ($mode, $file) = (split(' ', $_, 6))[0,5];
- next unless $file;
- $metapackage = 0 unless ($mode =~ /^d/ || $file =~ m%^\./usr/share/doc/%);
- }
- close IN;
-}
-if (($type eq "binary") || ($type eq 'udeb')) {
- my (%deps, %fields, %parsed);
- my $debugpackage = 0;
- my ($debugbase, $debugfound);
- if ($pkg =~ /^([^-]+)(?:-.*)?-dbg$/) {
- $debugpackage = 1;
- $debugbase = $1;
- }
- for my $field (qw(depends pre-depends recommends suggests conflicts provides replaces breaks)) {
- if (open(FH, '<', "fields/$field")) {
- #Get data and clean it
- my $data = <FH>;
- unfold($field, \$data);
- $data =~ s/^\s*(.+?)\s*$/$1/;
- $fields{$field} = $data;
- $parsed{$field} = Dep::parse ($data);
-
- my (@seen_libstdcs, @seen_tcls, @seen_tclxs, @seen_tks, @seen_tkxs, @seen_libpngs);
-
- my $is_dep_field = sub { grep { $_ eq $_[0] } qw(depends pre-depends recommends suggests) };
-
- tag "package-uses-breaks" if $field eq "breaks";
-
- tag "alternates-not-allowed", "$field"
- if ($data =~ /\|/ && ! &$is_dep_field($field));
-
- for my $dep (split /\s*,\s*/, $data) {
- my (@alternatives, @seen_obsolete_packages);
- push @alternatives, [_split_dep($_), $_] for (split /\s*\|\s*/, $dep);
-
- if (&$is_dep_field($field)) {
- push @seen_libstdcs, $alternatives[0]->[0]
- if defined $known_libstdcs{$alternatives[0]->[0]};
- push @seen_tcls, $alternatives[0]->[0]
- if defined $known_tcls{$alternatives[0]->[0]};
- push @seen_tclxs, $alternatives[0]->[0]
- if defined $known_tclxs{$alternatives[0]->[0]};
- push @seen_tks, $alternatives[0]->[0]
- if defined $known_tks{$alternatives[0]->[0]};
- push @seen_tkxs, $alternatives[0]->[0]
- if defined $known_tkxs{$alternatives[0]->[0]};
- push @seen_libpngs, $alternatives[0]->[0]
- if defined $known_libpngs{$alternatives[0]->[0]};
- }
-
- # Only for (Pre-)?Depends.
- tag "virtual-package-depends-without-real-package-depends", "$field: $alternatives[0]->[0]"
- if ($known_virtual_packages{$alternatives[0]->[0]}
- && ($field eq "depends" || $field eq "pre-depends"));
-
- # Check defaults for transitions. Here, we only care that the first alternative is current.
- tag "depends-on-old-emacs", "$field: $alternatives[0]->[0]"
- if (&$is_dep_field($field) && $known_obsolete_emacs{$alternatives[0]->[0]});
-
- for my $part_d (@alternatives) {
- my ($d_pkg, $d_version, $d_arch, $rest, $part_d_orig) = @$part_d;
-
- # We have found a Depends: on our non-dbg equivalent.
- if ($debugpackage && $field eq "depends" && $d_pkg =~ /^\Q$debugbase/) {
- $debugfound = 1;
- }
-
- tag "versioned-provides", "$part_d_orig"
- if ($field eq "provides" && $d_version->[0]);
-
- tag "breaks-without-version", "$part_d_orig"
- if ($field eq "breaks" && !$d_version->[0]);
-
- tag "obsolete-relation-form", "$field: $part_d_orig"
- if ($d_version && grep { $d_version->[0] eq $_ } ("<", ">"));
-
- tag "bad-version-in-relation", "$field: $part_d_orig"
- if ($d_version->[0] && ! defined((_valid_version($d_version->[1]))[1]));
-
- tag "package-relation-with-self", "$field: $part_d_orig"
- if ($pkg eq $d_pkg) && ($field ne 'conflicts');
-
- tag "bad-relation", "$field: $part_d_orig"
- if $rest;
-
- push @seen_obsolete_packages, $part_d_orig
- if ($obsolete_packages->known($d_pkg) && &$is_dep_field($field));
-
- tag "depends-on-x-metapackage", "$field: $part_d_orig"
- if ($known_x_metapackages{$d_pkg} && ! $metapackage && &$is_dep_field($field));
-
- tag "depends-on-essential-package-without-using-version", "$field: $part_d_orig"
- if ($known_essential{$d_pkg} && ! $d_version->[0] && &$is_dep_field($field));
-
- tag "package-depends-on-an-x-font-package", "$field: $part_d_orig"
- if ($field =~ /^(pre-)?depends$/ && $d_pkg =~ /^xfont.*/ && $d_pkg ne 'xfonts-utils' && $d_pkg ne 'xfongs-encodings');
-
- tag "needlessly-depends-on-awk", "$field"
- if ($d_pkg eq "awk" && ! $d_version->[0] && &$is_dep_field($field));
-
- tag "depends-on-libdb1-compat", "$field"
- if ($d_pkg eq "libdb1-compat" && $pkg !~ /^libc(6|6.1|0.3)/ && $field =~ /^(pre-)depends$/);
-
- tag "depends-on-python-minimal", "$field",
- if ($d_pkg =~ /^python[\d.]*-minimal$/ && &$is_dep_field($field)
- && $pkg !~ /^python[\d.]*-minimal$/);
-
- tag "doc-package-depends-on-main-package", "$field"
- if ("$d_pkg-doc" eq $pkg && $field =~ /^(pre-)depends$/);
-
- tag "old-versioned-python-dependency", "$field: $part_d_orig"
- if ($d_pkg eq 'python' && $d_version->[0] eq '<<' && &$is_dep_field($field)
- && $arch_indep && $pkg =~ /^python-/ && ! -f "fields/python-version");
- }
-
- for my $pkg (@seen_obsolete_packages) {
- if ($pkg eq $alternatives[0]->[0] or
- scalar @seen_obsolete_packages == scalar @alternatives) {
- tag "depends-on-obsolete-package", "$field: $pkg";
- } else {
- tag "ored-depends-on-obsolete-package", "$field: $pkg";
- }
- }
- }
- tag "package-depends-on-multiple-libstdc-versions", @seen_libstdcs
- if (scalar @seen_libstdcs > 1);
- tag "package-depends-on-multiple-tcl-versions", @seen_tcls
- if (scalar @seen_tcls > 1);
- tag "package-depends-on-multiple-tclx-versions", @seen_tclxs
- if (scalar @seen_tclxs > 1);
- tag "package-depends-on-multiple-tk-versions", @seen_tks
- if (scalar @seen_tks > 1);
- tag "package-depends-on-multiple-tkx-versions", @seen_tkxs
- if (scalar @seen_tkxs > 1);
- tag "package-depends-on-multiple-libpng-versions", @seen_libpngs
- if (scalar @seen_libpngs > 1);
- }
- }
-
- tag "dbg-package-missing-depends", $debugbase
- if ($debugpackage && !$debugfound);
-
- # If Conflicts or Breaks is set, make sure it's not inconsistent with
- # the other dependency fields.
- for my $conflict (qw/conflicts breaks/) {
- next unless $fields{$conflict};
- for my $field (qw(depends pre-depends recommends suggests)) {
- next unless $parsed{$field};
- for my $package (split /\s*,\s*/, $fields{$conflict}) {
- tag "conflicts-with-dependency", $field, $package
- if Dep::implies($parsed{$field}, Dep::parse($package));
- }
- }
- }
-}
-
-#---- Package relations (source package)
-
-if ($type eq "source") {
-
- #Get number of arch-indep packages:
- my $arch_indep_packages = 0;
- my $arch_dep_packages = 0;
- if (not open(CONTROL, '<', "debfiles/control")) {
- fail("Can't open debfiles/control: $!");
- } else {
- local $/ = "\n"; #Read this linewise
- while (<CONTROL>) {
- if (/^Architecture: all/) {
- $arch_indep_packages++;
- } elsif (/^Architecture:/) {
- $arch_dep_packages++;
- }
- }
- }
-
- # Search through rules and determine which dependencies are required.
- # The keys in %needed and %needed_clean are the dependencies; the
- # values are the tags to use or the empty string to use the default
- # tag.
- my (%needed, %needed_clean, %allowed_clean, $bypass_needed_clean);
- open (RULES, '<', "debfiles/rules")
- or fail("cannot read debfiles/rules: $!");
- my $target = "none";
- local $/ = "\n"; # Read this linewise
- my @rules = qw(clean binary-arch build-arch);
- my $maybe_skipping;
- while (<RULES>) {
- if (/^ifn?(eq|def)\s/) {
- $maybe_skipping++;
- } elsif (/^endif\s/) {
- $maybe_skipping--;
- }
- for my $rule (@global_clean_depends) {
- if ($_ =~ /$rule->[1]/) {
- if ($maybe_skipping) {
- $allowed_clean{$rule->[0]} = 1;
- } else {
- $needed_clean{$rule->[0]} = $rule->[2] || $needed_clean{$rule->[0]} || '';
- }
- }
- }
- for my $rule (@global_clean_allowed) {
- if ($_ =~ /$rule->[1]/) {
- $allowed_clean{$rule->[0]} = 1;
- }
- }
- for my $rule (@global_clean_bypass) {
- if ($_ =~ /$rule/) {
- $bypass_needed_clean = 1;
- }
- }
- for my $rule (@global_depends) {
- if ($_ =~ /$rule->[1]/ && !$maybe_skipping) {
- $needed{$rule->[0]} = $rule->[2] || $needed{$rule->[0]} || '';
- }
- }
- if (/^(\S+?):+(.*)/) {
- $target = $1;
- if (grep ($_ eq $target, @rules)) {
- push (@rules, split (' ', $2));
- }
- }
- if (grep ($_ eq $target, @rules)) {
- for my $rule (@rule_clean_depends) {
- if ($_ =~ /$rule->[1]/) {
- if ($maybe_skipping) {
- $allowed_clean{$rule->[0]} = 1;
- } else {
- $needed_clean{$rule->[0]} = $rule->[2] || $needed_clean{$rule->[0]} || '';
- }
- }
- }
- for my $rule (@rule_clean_allowed) {
- if ($_ =~ /$rule->[1]/) {
- $allowed_clean{$rule->[0]} = 1;
- }
- }
- }
- }
- close RULES;
- $/ = undef; # Back to reading everything.
-
- tag "build-depends-indep-without-arch-indep", ""
- if (-e "fields/build-depends-indep" && $arch_indep_packages == 0);
-
- my $is_dep_field = sub { grep { $_ eq $_[0] } qw(build-depends build-depends-indep) };
-
- my %depend;
- for my $field (qw(build-depends build-depends-indep build-conflicts build-conflicts-indep)) {
- if (open(FH, '<', "fields/$field")) {
- #Get data and clean it
- my $data = <FH>;
- unfold($field, \$data);
- $data =~ s/^\s*(.+?)\s*$/$1/;
- $depend{$field} = $data;
-
- for my $dep (split /\s*,\s*/, $data) {
- my @alternatives;
- push @alternatives, [_split_dep($_), $_] for (split /\s*\|\s*/, $dep);
-
- tag "virtual-package-depends-without-real-package-depends", "$field: $alternatives[0]->[0]"
- if ($known_virtual_packages{$alternatives[0]->[0]} && &$is_dep_field($field));
-
- for my $part_d (@alternatives) {
- my ($d_pkg, $d_version, $d_arch, $rest, $part_d_orig) = @$part_d;
-
- for my $arch (@{$d_arch->[0]}) {
- if (!$known_archs{$arch}) {
- tag "invalid-arch-string-in-source-relation", "$arch [$field: $part_d_orig]"
- }
- }
-
- tag "build-depends-on-build-essential", $field
- if ($d_pkg eq "build-essential");
-
- tag "depends-on-build-essential-package-without-using-version", "$d_pkg [$field: $part_d_orig]"
- if ($known_build_essential{$d_pkg} && ! $d_version->[1]);
-
- tag "build-depends-on-essential-package-without-using-version", "$field: $part_d_orig"
- if ($d_pkg ne "coreutils" && $known_essential{$d_pkg} && ! $d_version->[0]);
- tag "build-depends-on-obsolete-package", "$field: $part_d_orig"
- if ($obsolete_packages->known($d_pkg) && &$is_dep_field($field));
-
- tag "build-depends-on-x-metapackage", "$field: $part_d_orig"
- if ($known_x_metapackages{$d_pkg} && &$is_dep_field($field));
-
- tag "build-depends-on-1-revision", "$field: $part_d_orig"
- if ($d_version->[0] eq '>=' && $d_version->[1] =~ /-1$/ && &$is_dep_field($field));
-
- tag "bad-relation", "$field: $part_d_orig"
- if $rest;
- }
- }
- }
- }
-
- # Check for duplicates.
- my $build_all = $depend{'build-depends'} || '';
- $build_all .= ', ' if $depend{'build-depends'} && $depend{'build-depends-indep'};
- $build_all .= $depend{'build-depends-indep'} || '';
- my @dups = Dep::get_dups(Dep::parse($build_all));
- for my $dup (@dups) {
- tag "package-has-a-duplicate-build-relation", join (', ', @$dup);
- }
-
- # Make sure build dependencies and conflicts are consistent.
- $depend{'build-depends'} = Dep::parse($depend{'build-depends'} || '');
- $depend{'build-depends-indep'} = Dep::parse($depend{'build-depends-indep'} || '');
- for ($depend{'build-conflicts'}, $depend{'build-conflicts-indep'}) {
- next unless $_;
- for my $conflict (split /\s*,\s*/, $_) {
- if (Dep::implies($depend{'build-depends'}, Dep::parse($conflict))
- || Dep::implies($depend{'build-depends-indep'}, Dep::parse($conflict))) {
- tag "build-conflicts-with-build-dependency", $conflict;
- }
- }
- }
-
- # Make sure that all the required build dependencies are there. Don't
- # issue missing-build-dependency errors for debhelper, since there's
- # another test that does that and it would just be a duplicate.
- for my $package (keys %needed_clean) {
- my $dep = Dep::parse($package);
- my $tag = $needed_clean{$package} || 'missing-build-dependency';
- unless (Dep::implies($depend{'build-depends'}, $dep)) {
- if (Dep::implies($depend{'build-depends-indep'}, $dep)) {
- tag "clean-should-be-satisfied-by-build-depends", $package;
- } else {
- if ($tag eq 'missing-build-dependency') {
- tag $tag, $package if $package ne 'debhelper';
- } else {
- tag $tag;
- }
- }
- }
- }
- for my $package (keys %needed) {
- my $dep = Dep::parse($package);
- my $tag = $needed{$package} || 'missing-build-dependency';
-
- # dh_python deactivates itself if the new Python build policy
- # is enabled.
- if ($tag eq 'missing-dh_python-build-dependency') {
- next if -f 'debfiles/pycomat';
- next if -f 'fields/python-version';
- }
- unless (Dep::implies($depend{'build-depends'}, $dep)) {
- unless (Dep::implies($depend{'build-depends-indep'}, $dep)) {
- if ($tag eq 'missing-build-dependency') {
- tag $tag, $package;
- } else {
- tag $tag;
- }
- }
- }
- }
-
- # This check is a bit tricky. We want to allow in Build-Depends a
- # dependency with any version, since reporting this tag over version
- # mismatches would be confusing and quite likely wrong. The approach
- # taken is to strip the version information off all dependencies
- # allowed in Build-Depends, strip the version information off of the
- # dependencies in Build-Depends, and then allow any dependency in
- # Build-Depends that's implied by the dependencies we require or allow
- # there.
- #
- # We also have to map | to , when building the list of allowed
- # packages so that the implications will work properly.
- #
- # This is confusing. There should be a better way to do this.
- if (-e "fields/build-depends" && $arch_dep_packages == 0 && !$bypass_needed_clean) {
- open(FH, '<', "fields/build-depends")
- or fail("cannot read fields/build-depends: $!");
- my $build_depends = <FH>;
- close FH;
- my @packages = split /\s*,\s*/, $build_depends;
- my @allowed = map { s/[\(\[][^\)\]]+[\)\]]//g; s/\|/,/g; $_ } keys (%needed_clean), keys (%allowed_clean);
- my $dep = Dep::parse (join (',', @allowed));
- foreach my $pkg (@packages) {
- my $name = $pkg;
- $name =~ s/[\[\(][^\)\]]+[\)\]]//g;
- $name =~ s/\s+$//;
- $name =~ s/\s+/ /g;
- unless (Dep::implies($dep, Dep::parse($name))) {
- tag "build-depends-without-arch-dep", $name;
- }
- }
- }
-}
-
-#----- Origin
-
-if (open(FH, '<', "fields/origin")) {
- my $origin = <FH>;
- close(FH);
-
- unfold('origin', \$origin);
-
- tag "redundant-origin-field", "" if $origin =~ /^\s*debian\s*$/i;
-}
-
-#----- Bugs
-
-if (open(FH, '<', "fields/bugs")) {
- my $bugs = <FH>;
- close FH;
-
- unfold('bugs', \$bugs);
-
- tag "redundant-bugs-field"
- if $bugs =~ m,^\s*debbugs://bugs.debian.org/?\s*$,i;
-}
-
-#----- Python-Version
-
-if (open(FH, '<', "fields/python-version")) {
- my $pyversion = <FH>;
- close FH;
-
- unfold('python-version', \$pyversion);
-
- my @valid = ([ '\d+\.\d+', '\d+\.\d+' ],
- [ '\d+\.\d+' ],
- [ '\>=\s*\d+\.\d+', '\<\<\s*\d+\.\d+' ],
- [ '\>=\s*\d+\.\d+' ],
- [ 'current', '\>=\s*\d+\.\d+' ],
- [ 'current' ],
- [ 'all' ]);
-
- my @pyversion = split(/\s*,\s*/, $pyversion);
- if (@pyversion > 2) {
- if (grep { !/^\d+\.\d+$/ } @pyversion) {
- tag "malformed-python-version", "$pyversion";
- }
- } else {
- my $okay = 0;
- for my $rule (@valid) {
- if ($pyversion[0] =~ /^$rule->[0]$/
- && (($pyversion[1] && $rule->[1] && $pyversion[1] =~ /^$rule->[1]$/)
- || (! $pyversion[1] && ! $rule->[1]))) {
- $okay = 1;
- last;
- }
- }
- tag "malformed-python-version", "$pyversion" unless $okay;
- }
-}
-
-#----- Dm-Upload-Allowed
-
-if (open(FH, '<', 'fields/dm-upload-allowed')) {
- my $dmupload = <FH>;
- close FH;
-
- unfold('dm-upload-allowed', \$dmupload);
-
- unless ($dmupload =~ /^\s*yes\s*$/) {
- tag "malformed-dm-upload-allowed", "$dmupload";
- }
-}
-
-#----- Field checks (without checking the value)
-
-for my $field (glob("fields/*")) {
- $field =~ s!^fields/!!;
-
- next if ($field eq 'original-maintainer') and $version =~ /ubuntu/;
-
- tag "obsolete-field", "$field"
- if $known_obsolete_fields{$field};
-
- tag "unknown-field-in-dsc", "$field"
- if ($type eq "source" && ! $known_source_fields{$field} && ! $known_obsolete_fields{$field});
-
- tag "unknown-field-in-control", "$field"
- if ($type eq "binary" && ! $known_binary_fields{$field} && ! $known_obsolete_fields{$field});
-
- tag "unknown-field-in-control", "$field"
- if ($type eq "udeb" && ! $known_udeb_fields{$field} && ! $known_obsolete_fields{$field});
-}
-
-}
-
-# splits "foo (>= 1.2.3) [!i386 ia64]" into
-# ( "foo", [ ">=", "1.2.3" ], [ [ "i386", "ia64" ], 1 ], "" )
-# ^^^ ^^
-# true, if ! was given ||
-# rest (should always be "" for valid dependencies)
-sub _split_dep {
- my $dep = shift;
- my ($pkg, $version, $darch) = ("", ["",""], [[],""]);
-
- $pkg = $1 if $dep =~ s/^\s*([^\s\[\(]+)\s*//;
-
- if (length $dep) {
- if ($dep =~ s/\s* \( \s* (<<|<=|<|=|>=|>>|>) \s* ([^\s(]+) \s* \) \s*//x) {
- @$version = ($1, $2);
- }
- if ($dep && $dep =~ s/\s*\[([^\]]+)\]\s*//) {
- my $t = $1;
- $darch->[1] = 1 if ($t =~ s/!//g);
- $darch->[0] = [ split /\s+/, $t ];
- }
- }
-
- return ($pkg, $version, $darch, $dep);
-}
-
-sub _valid_version {
- my $ver = shift;
-
- # epoch check means nothing here... This check is only useful to detect
- # weird characters in version (and to get the debian revision)
- if ($ver =~ m/^(\d+:)?([-\.+:~A-Z0-9]+?)(-[\.+~A-Z0-9]+)?$/i) {
- return ($1, $2, $3);
- } else {
- return ();
- }
-}
-
-sub unfold {
- my $field = shift;
- my $line = shift;
-
- $$line =~ s/\n$//;
-
- if ($$line =~ s/\n//g) {
- tag "multiline-field", "$field";
- }
-}
-
-sub check_maint {
- my ($maintainer, $f) = @_;
- $maintainer =~ /^([^<\s]*(?:\s+[^<\s]+)*)?(\s*)(?:<(.+)>)?(.*)$/,
- my ($name, $del, $mail, $crap) = ($1, $2, $3, $4);
-
- if (!$mail && $name =~ m/@/) { # name probably missing and address has no <>
- $mail = $name;
- $name = undef;
- }
-
- tag "$f-address-malformed", "$maintainer" if $crap;
- tag "$f-address-looks-weird", "$maintainer" if ! $del && $name && $mail;
-
- # Wookey really only has one name. If we get more of these, consider
- # removing the check.
- if (! $name) {
- tag "$f-name-missing", "$maintainer";
- } elsif ($name !~ /^\S+\s+\S+/ && $name ne 'Wookey') {
- tag "$f-not-full-name", "$name";
- }
-
- #This should be done with Email::Valid:
- if (!$mail) {
- tag "$f-address-missing", "$maintainer";
- } else {
- tag "$f-address-malformed", "$maintainer"
- unless ($mail =~ /^[^()<>@,;:\\"[\]]+@(\S+\.)+\S+/); #"
-
- tag "$f-address-is-on-localhost", "$maintainer"
- if ($mail =~ /(?:localhost|\.localdomain|\.localnet)$/);
-
- tag "wrong-debian-qa-address-set-as-maintainer", "$maintainer"
- if ($f eq "maintainer" && $mail eq 'debian-qa@lists.debian.org');
-
- tag "wrong-debian-qa-group-name", "$maintainer"
- if ($f eq "maintainer" && $mail eq 'packages@qa.debian.org' &&
- $name ne 'Debian QA Group');
- }
-}
-
-1;
-
-# Local Variables:
-# indent-tabs-mode: t
-# cperl-indent-level: 8
-# End:
-# vim: syntax=perl sw=4 ts=4 noet shiftround
projects / maemian / blobdiff