# 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