X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Fchecks%2Fcruft;fp=nokia-lintian%2Fchecks%2Fcruft;h=ae58ad35e98fbf151ba9b096b0d0d75d4dd11987;hb=1975b83207a518d59ef6b04c7c16233cb353ca86;hp=0000000000000000000000000000000000000000;hpb=208f636c44e0ec2b53c70aaed2399d8e9cf0e741;p=maemian diff --git a/nokia-lintian/checks/cruft b/nokia-lintian/checks/cruft new file mode 100644 index 0000000..ae58ad3 --- /dev/null +++ b/nokia-lintian/checks/cruft @@ -0,0 +1,240 @@ +# cruft -- lintian check script -*- perl -*- +# +# based on debhelper check, +# Copyright (C) 1999 Joey Hess +# Copyright (C) 2000 Sean 'Shaleh' Perry +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2007 Russ Allbery +# +# 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::cruft; +use strict; + +use Dep; +use Tags; +use Util; + +use Cwd; +use File::Find; +use File::Basename; + +# All the packages that may provide config.{sub,guess} during the build, used +# to suppress warnings about outdated autotools helper files. +my $autotools_pkgs = join ' | ', + qw(autotools-dev automake automaken automake1.4 automake1.7 automake1.8 + automake1.9 automake1.10); + +# Directory checks. These regexes match a directory that shouldn't be in the +# source package and associate it with a tag (minus the leading +# source-contains or diff-contains). Note that only one of these regexes +# should trigger for any single directory. +my @directory_checks = + ([ qr,^(.+/)?CVS$, => 'cvs-control-dir' ], + [ qr,^(.+/)?\.svn$, => 'svn-control-dir' ], + [ qr,^(.+/)?\.bzr$, => 'bzr-control-dir' ], + [ qr,^(.+/)?\{arch\}$, => 'arch-control-dir' ], + [ qr,^(.+/)?\.arch-ids$, => 'arch-control-dir' ], + [ qr!^(.+/)?,,.+$! => 'arch-control-dir' ], + [ qr,^(.+/)?\.git$, => 'git-control-dir' ], + [ qr,^(.+/)?\.hg$, => 'hg-control-dir' ], + [ qr,^(.+/)?\.be$, => 'bts-control-dir' ], + [ qr,^(.+/)?\.ditrack$, => 'bts-control-dir' ], + ); + +# File checks. These regexes match files that shouldn't be in the source +# package and associate them with a tag (minus the leading source-contains or +# diff-contains). Note that only one of these regexes should trigger for any +# given file. If the third column is a true value, don't issue this tag +# unless the file is included in the diff; it's too common in source packages +# and not important enough to worry about. +my @file_checks = + ([ qr,^(.+/)?svn-commit\.(.+\.)?tmp$, => 'svn-commit-file' ], + [ qr,^(.+/)?svk-commit.+\.tmp$, => 'svk-commit-file' ], + [ qr,^(.+/)?\.arch-inventory$, => 'arch-inventory-file' ], + [ qr,^(.+/)?\.\#(.+?)\.\d+(\.\d+)*$, => 'cvs-conflict-copy' ], + [ qr,^(.+/)?(.+?)\.(r\d+)$, => 'svn-conflict-file' ], + [ qr,\.(orig|rej)$, => 'patch-failure-file', 1 ], + [ qr,((^|/)\.[^/]+\.swp|~)$, => 'editor-backup-file', 1 ], + ); + +# Records files warned about in the diff so that we don't warn about them +# again in the source checks. +my %warned; + +# Whether this is a native Debian package. +my $native; + +my $dir; +my $atdinbd; + +# Used in the find function. +my $pkg; +my $info; + +sub run { + +$pkg = shift; +my $type = shift; +$info = shift; + +if (-e "debfiles/files" and not -z "debfiles/files") { + tag 'debian-files-list-in-source'; +} + +# This doens't really belong here, but there isn't a better place at the +# moment to put this check. +if ($info->native) { + my $version = $info->field('version'); + if ($version =~ /-/ and $version !~ /-0\.[^-]+$/) { + tag 'native-package-with-dash-version'; + } +} + +# Check if this is a documentation package that's not arch: all. This doesn't +# really belong here either. +my $arch; +if (open IN, '<', "fields/architecture") { + chop($arch = ); + close IN; + if ($pkg =~ /-docs?$/ && $arch ne 'all') { + tag 'documentation-package-not-architecture-independent'; + } +} + +# Read build-depends file and see if it depends on autotools-dev or automake. +# I'm not thrilled with having the automake exception as well, but people do +# depend on autoconf and automake and then use autoreconf to update +# config.guess and config.sub, and automake depends on autotools-dev. +$atdinbd = 0; +if (open IN, '<', "fields/build-depends") { + my $bd; + chop($bd = ); + close IN; + $atdinbd = 1 if Dep::implies(Dep::parse($bd), Dep::parse($autotools_pkgs)); +} + +check_diffstat("diffstat"); +find(\&find_cruft, 'unpacked'); + +} # + +# ----------------------------------- + +# Check the diff for problems. Record any files we warn about in %warned so +# that we don't warn again when checking the full unpacked source. Takes the +# name of a file containing diffstat output. +# +# Exclude the lintian package itself from many of these checks, since it +# includes many of these problems in its test suite. +sub check_diffstat { + my ($diffstat) = @_; + open(STAT, '<', $diffstat) or fail("cannot open $diffstat: $!"); + local $_; + while () { + my ($file) = (m,^\s+(.*?)\s+\|,) + or fail("syntax error in diffstat file: $_"); + + # We only care about diffs that add files. If the file is being + # modified, that's not a problem with the diff and we'll catch it + # later when we check the source. This regex doesn't catch only file + # adds, just any diff that doesn't remove lines from a file, but it's + # a good guess. + next unless m,\|\s+\d+\s+\++$,; + + # diffstat output contains only files, but we consider the directory + # checks to trigger if the diff adds any files in those directories. + my ($directory) = ($file =~ m,^(.*)/[^/]+$,); + if ($directory and not $warned{$directory}) { + for my $rule (@directory_checks) { + if ($directory =~ /$rule->[0]/) { + tag "diff-contains-$rule->[1]", $directory; + $warned{$directory} = 1; + } + } + } + + # Now the simpler file checks. + for my $rule (@file_checks) { + if ($file =~ /$rule->[0]/) { + tag "diff-contains-$rule->[1]", $file; + $warned{$file} = 1; + } + } + + # Additional special checks only for the diff, not the full source. + if ($file =~ m,^debian/substvars$,) { + tag 'diff-contains-substvars', $file; + } + } + close(STAT) or fail("error reading diffstat file: $!"); +} + +# Check each file in the source package for problems. By the time we get to +# this point, we've already checked the diff and warned about anything added +# there, so we only warn about things that weren't in the diff here. +# +# Report problems with native packages using the "diff-contains" rather than +# "source-contains" tag. The tag isn't entirely accurate, but it's better +# than creating yet a third set of tags, and this gets the severity right. +sub find_cruft { + (my $name = $File::Find::name) =~ s,^(\./)?unpacked/,,; + my $prefix = ($info->native ? "diff-contains" : "source-contains"); + if (-d and not $warned{$name}) { + for my $rule (@directory_checks) { + if ($name =~ /$rule->[0]/) { + tag "${prefix}-$rule->[1]", $name unless $pkg eq 'lintian'; + } + } + } + -f or return; # we just need normal files for the rest + + unless ($warned{$name}) { + for my $rule (@file_checks) { + next if ($rule->[2] and not $info->native); + if ($name =~ /$rule->[0]/) { + tag "${prefix}-$rule->[1]", $name unless $pkg eq 'lintian'; + } + } + } + + # Tests of autotools files are a special case. Ignore debian/config.cache + # as anyone doing that probably knows what they're doing and is using it + # as part of the build. + if ($name =~ m,^(.+/)?config.(?:cache|log|status)$,) { + if ($name !~ m,^debian/config\.cache$, and $pkg ne 'lintian') { + tag "configure-generated-file-in-source", $name; + } + } elsif ($name =~ m,^(.+/)?config.(?:guess|sub)$, and not $atdinbd) { + my $b = basename $name; + open (F, '<', $b) or die "can't open $name: $!"; + while () { + last if $. > 10; # it's on the 6th line, but be a bit more lenient + if (/^(?:timestamp|version)='(\d+)(.+)'$/ and $1 < 2004) { + tag "outdated-autotools-helper-file", $name, "$1$2"; + } + } + close F; + } +} +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: ts=8 sw=4 noet syntax=perl