vcs.maemo.org Git - maemian/blob - nokia-lintian/checks/cruft

   1 # cruft -- lintian check script -*- perl -*-
   2 #
   3 # based on debhelper check,
   4 # Copyright (C) 1999 Joey Hess
   5 # Copyright (C) 2000 Sean 'Shaleh' Perry
   6 # Copyright (C) 2002 Josip Rodin
   7 # Copyright (C) 2007 Russ Allbery
   8 #
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, you can find it on the World Wide
  21 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  22 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  23 # MA 02110-1301, USA.
  24
  25 package Lintian::cruft;
  26 use strict;
  27
  28 use Dep;
  29 use Tags;
  30 use Util;
  31
  32 use Cwd;
  33 use File::Find;
  34 use File::Basename;
  35
  36 # All the packages that may provide config.{sub,guess} during the build, used
  37 # to suppress warnings about outdated autotools helper files.
  38 my $autotools_pkgs = join ' | ',
  39     qw(autotools-dev automake automaken automake1.4 automake1.7 automake1.8
  40        automake1.9 automake1.10);
  41
  42 # Directory checks.  These regexes match a directory that shouldn't be in the
  43 # source package and associate it with a tag (minus the leading
  44 # source-contains or diff-contains).  Note that only one of these regexes
  45 # should trigger for any single directory.
  46 my @directory_checks =
  47     ([ qr,^(.+/)?CVS$,        => 'cvs-control-dir'  ],
  48      [ qr,^(.+/)?\.svn$,      => 'svn-control-dir'  ],
  49      [ qr,^(.+/)?\.bzr$,      => 'bzr-control-dir'  ],
  50      [ qr,^(.+/)?\{arch\}$,   => 'arch-control-dir' ],
  51      [ qr,^(.+/)?\.arch-ids$, => 'arch-control-dir' ],
  52      [ qr!^(.+/)?,,.+$!       => 'arch-control-dir' ],
  53      [ qr,^(.+/)?\.git$,      => 'git-control-dir'  ],
  54      [ qr,^(.+/)?\.hg$,       => 'hg-control-dir'   ],
  55      [ qr,^(.+/)?\.be$,       => 'bts-control-dir'  ],
  56      [ qr,^(.+/)?\.ditrack$,  => 'bts-control-dir'  ],
  57     );
  58
  59 # File checks.  These regexes match files that shouldn't be in the source
  60 # package and associate them with a tag (minus the leading source-contains or
  61 # diff-contains).  Note that only one of these regexes should trigger for any
  62 # given file.  If the third column is a true value, don't issue this tag
  63 # unless the file is included in the diff; it's too common in source packages
  64 # and not important enough to worry about.
  65 my @file_checks =
  66     ([ qr,^(.+/)?svn-commit\.(.+\.)?tmp$, => 'svn-commit-file'        ],
  67      [ qr,^(.+/)?svk-commit.+\.tmp$,      => 'svk-commit-file'        ],
  68      [ qr,^(.+/)?\.arch-inventory$,       => 'arch-inventory-file'    ],
  69      [ qr,^(.+/)?\.\#(.+?)\.\d+(\.\d+)*$, => 'cvs-conflict-copy'      ],
  70      [ qr,^(.+/)?(.+?)\.(r\d+)$,          => 'svn-conflict-file'      ],
  71      [ qr,\.(orig|rej)$,                  => 'patch-failure-file',  1 ],
  72      [ qr,((^|/)\.[^/]+\.swp|~)$,         => 'editor-backup-file',  1 ],
  73     );
  74
  75 # Records files warned about in the diff so that we don't warn about them
  76 # again in the source checks.
  77 my %warned;
  78
  79 # Whether this is a native Debian package.
  80 my $native;
  81
  82 my $dir;
  83 my $atdinbd;
  84
  85 # Used in the find function.
  86 my $pkg;
  87 my $info;
  88
  89 sub run {
  90
  91 $pkg = shift;
  92 my $type = shift;
  93 $info = shift;
  94
  95 if (-e "debfiles/files" and not -z "debfiles/files") {
  96     tag 'debian-files-list-in-source';
  97 }
  98
  99 # This doens't really belong here, but there isn't a better place at the
 100 # moment to put this check.
 101 if ($info->native) {
 102     my $version = $info->field('version');
 103     if ($version =~ /-/ and $version !~ /-0\.[^-]+$/) {
 104         tag 'native-package-with-dash-version';
 105     }
 106 }
 107
 108 # Check if this is a documentation package that's not arch: all.  This doesn't
 109 # really belong here either.
 110 my $arch;
 111 if (open IN, '<', "fields/architecture") {
 112     chop($arch = <IN>);
 113     close IN;
 114     if ($pkg =~ /-docs?$/ && $arch ne 'all') {
 115         tag 'documentation-package-not-architecture-independent';
 116     }
 117 }
 118
 119 # Read build-depends file and see if it depends on autotools-dev or automake.
 120 # I'm not thrilled with having the automake exception as well, but people do
 121 # depend on autoconf and automake and then use autoreconf to update
 122 # config.guess and config.sub, and automake depends on autotools-dev.
 123 $atdinbd = 0;
 124 if (open IN, '<', "fields/build-depends") {
 125     my $bd;
 126     chop($bd = <IN>);
 127     close IN;
 128     $atdinbd = 1 if Dep::implies(Dep::parse($bd), Dep::parse($autotools_pkgs));
 129 }
 130
 131 check_diffstat("diffstat");
 132 find(\&find_cruft, 'unpacked');
 133
 134 } # </run>
 135
 136 # -----------------------------------
 137
 138 # Check the diff for problems.  Record any files we warn about in %warned so
 139 # that we don't warn again when checking the full unpacked source.  Takes the
 140 # name of a file containing diffstat output.
 141 #
 142 # Exclude the lintian package itself from many of these checks, since it
 143 # includes many of these problems in its test suite.
 144 sub check_diffstat {
 145     my ($diffstat) = @_;
 146     open(STAT, '<', $diffstat) or fail("cannot open $diffstat: $!");
 147     local $_;
 148     while (<STAT>) {
 149         my ($file) = (m,^\s+(.*?)\s+\|,)
 150             or fail("syntax error in diffstat file: $_");
 151
 152         # We only care about diffs that add files.  If the file is being
 153         # modified, that's not a problem with the diff and we'll catch it
 154         # later when we check the source.  This regex doesn't catch only file
 155         # adds, just any diff that doesn't remove lines from a file, but it's
 156         # a good guess.
 157         next unless m,\|\s+\d+\s+\++$,;
 158
 159         # diffstat output contains only files, but we consider the directory
 160         # checks to trigger if the diff adds any files in those directories.
 161         my ($directory) = ($file =~ m,^(.*)/[^/]+$,);
 162         if ($directory and not $warned{$directory}) {
 163             for my $rule (@directory_checks) {
 164                 if ($directory =~ /$rule->[0]/) {
 165                     tag "diff-contains-$rule->[1]", $directory;
 166                     $warned{$directory} = 1;
 167                 }
 168             }
 169         }
 170
 171         # Now the simpler file checks.
 172         for my $rule (@file_checks) {
 173             if ($file =~ /$rule->[0]/) {
 174                 tag "diff-contains-$rule->[1]", $file;
 175                 $warned{$file} = 1;
 176             }
 177         }
 178
 179         # Additional special checks only for the diff, not the full source.
 180         if ($file =~ m,^debian/substvars$,) {
 181             tag 'diff-contains-substvars', $file;
 182         }
 183     }
 184     close(STAT) or fail("error reading diffstat file: $!");
 185 }
 186
 187 # Check each file in the source package for problems.  By the time we get to
 188 # this point, we've already checked the diff and warned about anything added
 189 # there, so we only warn about things that weren't in the diff here.
 190 #
 191 # Report problems with native packages using the "diff-contains" rather than
 192 # "source-contains" tag.  The tag isn't entirely accurate, but it's better
 193 # than creating yet a third set of tags, and this gets the severity right.
 194 sub find_cruft {
 195     (my $name = $File::Find::name) =~ s,^(\./)?unpacked/,,;
 196     my $prefix = ($info->native ? "diff-contains" : "source-contains");
 197     if (-d and not $warned{$name}) {
 198         for my $rule (@directory_checks) {
 199             if ($name =~ /$rule->[0]/) {
 200                 tag "${prefix}-$rule->[1]", $name unless $pkg eq 'lintian';
 201             }
 202         }
 203     }
 204     -f or return; # we just need normal files for the rest
 205
 206     unless ($warned{$name}) {
 207         for my $rule (@file_checks) {
 208             next if ($rule->[2] and not $info->native);
 209             if ($name =~ /$rule->[0]/) {
 210                 tag "${prefix}-$rule->[1]", $name unless $pkg eq 'lintian';
 211             }
 212         }
 213     }
 214
 215     # Tests of autotools files are a special case.  Ignore debian/config.cache
 216     # as anyone doing that probably knows what they're doing and is using it
 217     # as part of the build.
 218     if ($name =~ m,^(.+/)?config.(?:cache|log|status)$,) {
 219         if ($name !~ m,^debian/config\.cache$, and $pkg ne 'lintian') {
 220             tag "configure-generated-file-in-source", $name;
 221         }
 222     } elsif ($name =~ m,^(.+/)?config.(?:guess|sub)$, and not $atdinbd) {
 223         my $b = basename $name;
 224         open (F, '<', $b) or die "can't open $name: $!";
 225         while (<F>) {
 226             last if $. > 10; # it's on the 6th line, but be a bit more lenient
 227             if (/^(?:timestamp|version)='(\d+)(.+)'$/ and $1 < 2004) {
 228                 tag "outdated-autotools-helper-file", $name, "$1$2";
 229             }
 230         }
 231         close F;
 232     }
 233 }
 234 1;
 235
 236 # Local Variables:
 237 # indent-tabs-mode: nil
 238 # cperl-indent-level: 4
 239 # End:
 240 # vim: ts=8 sw=4 noet syntax=perl