X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Fchecks%2Ffields;fp=nokia-lintian%2Fchecks%2Ffields;h=dc72f16955822845dcc72796bee279bc29ca0b86;hb=1975b83207a518d59ef6b04c7c16233cb353ca86;hp=0000000000000000000000000000000000000000;hpb=208f636c44e0ec2b53c70aaed2399d8e9cf0e741;p=maemian diff --git a/nokia-lintian/checks/fields b/nokia-lintian/checks/fields new file mode 100644 index 0000000..dc72f16 --- /dev/null +++ b/nokia-lintian/checks/fields @@ -0,0 +1,997 @@ +# 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