X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Fchecks%2Ffields;fp=nokia-lintian%2Fchecks%2Ffields;h=0000000000000000000000000000000000000000;hb=bf47c4c43f1f5f4986e85b74fc82b32048aeb846;hp=dc72f16955822845dcc72796bee279bc29ca0b86;hpb=19fdce4b743853cee27edb892096cf64295c2874;p=maemian diff --git a/nokia-lintian/checks/fields b/nokia-lintian/checks/fields deleted file mode 100644 index dc72f16..0000000 --- a/nokia-lintian/checks/fields +++ /dev/null @@ -1,997 +0,0 @@ -# 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 = ; - 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 () { - 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 = ; - 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 () { - 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 () { - 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 = ; - 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 = ; - 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 = ; - close(FH); - - unfold('origin', \$origin); - - tag "redundant-origin-field", "" if $origin =~ /^\s*debian\s*$/i; -} - -#----- Bugs - -if (open(FH, '<', "fields/bugs")) { - my $bugs = ; - 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 = ; - 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 = ; - 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