vcs.maemo.org Git - maemian/blob - 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 Maemian::cruft;
  26 use strict;
  27
  28 use Maemian::Relation ();
  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.  I'm not
  38 # thrilled with having the automake exception as well, but people do depend on
  39 # autoconf and automake and then use autoreconf to update config.guess and
  40 # config.sub, and automake depends on autotools-dev.
  41 our $AUTOTOOLS = Maemian::Relation->new(join(' | ',
  42     qw(autotools-dev automake automaken automake1.4 automake1.7 automake1.8
  43        automake1.9 automake1.10)));
  44
  45 # The files that contain error messages from tar, which we'll check and issue
  46 # tags for if they contain something unexpected, and their corresponding tags.
  47 our %ERRORS = ('index-errors'    => 'tar-errors-from-source',
  48                'unpacked-errors' => 'tar-errors-from-source');
  49
  50 # Directory checks.  These regexes match a directory that shouldn't be in the
  51 # source package and associate it with a tag (minus the leading
  52 # source-contains or diff-contains).  Note that only one of these regexes
  53 # should trigger for any single directory.
  54 my @directory_checks =
  55     ([ qr,^(.+/)?CVS$,        => 'cvs-control-dir'  ],
  56      [ qr,^(.+/)?\.svn$,      => 'svn-control-dir'  ],
  57      [ qr,^(.+/)?\.bzr$,      => 'bzr-control-dir'  ],
  58      [ qr,^(.+/)?\{arch\}$,   => 'arch-control-dir' ],
  59      [ qr,^(.+/)?\.arch-ids$, => 'arch-control-dir' ],
  60      [ qr!^(.+/)?,,.+$!       => 'arch-control-dir' ],
  61      [ qr,^(.+/)?\.git$,      => 'git-control-dir'  ],
  62      [ qr,^(.+/)?\.hg$,       => 'hg-control-dir'   ],
  63      [ qr,^(.+/)?\.be$,       => 'bts-control-dir'  ],
  64      [ qr,^(.+/)?\.ditrack$,  => 'bts-control-dir'  ],
  65     );
  66
  67 # File checks.  These regexes match files that shouldn't be in the source
  68 # package and associate them with a tag (minus the leading source-contains or
  69 # diff-contains).  Note that only one of these regexes should trigger for any
  70 # given file.  If the third column is a true value, don't issue this tag
  71 # unless the file is included in the diff; it's too common in source packages
  72 # and not important enough to worry about.
  73 my @file_checks =
  74     ([ qr,^(.+/)?svn-commit\.(.+\.)?tmp$, => 'svn-commit-file'        ],
  75      [ qr,^(.+/)?svk-commit.+\.tmp$,      => 'svk-commit-file'        ],
  76      [ qr,^(.+/)?\.arch-inventory$,       => 'arch-inventory-file'    ],
  77      [ qr,^(.+/)?\.hgtags$,               => 'hg-tags-file'           ],
  78      [ qr,^(.+/)?\.\#(.+?)\.\d+(\.\d+)*$, => 'cvs-conflict-copy'      ],
  79      [ qr,^(.+/)?(.+?)\.(r\d+)$,          => 'svn-conflict-file'      ],
  80      [ qr,\.(orig|rej)$,                  => 'patch-failure-file',  1 ],
  81      [ qr,((^|/)\.[^/]+\.swp|~)$,         => 'editor-backup-file',  1 ],
  82     );
  83
  84
  85 sub run {
  86
  87 my $pkg = shift;
  88 my $type = shift;
  89 my $info = shift;
  90
  91 if (-e "debfiles/files" and not -z "debfiles/files") {
  92     tag 'debian-files-list-in-source';
  93 }
  94
  95 # This doens't really belong here, but there isn't a better place at the
  96 # moment to put this check.
  97 if ($info->native) {
  98     my $version = $info->field('version');
  99     if ($version =~ /-/ and $version !~ /-0\.[^-]+$/) {
 100         tag 'native-package-with-dash-version';
 101     }
 102 }
 103
 104 # Check if this is a documentation package that's not arch: all.  This doesn't
 105 # really belong here either.
 106 my $arch;
 107 if (defined $info->field('architecture')) {
 108     my $arch = $info->field('architecture');
 109     if ($pkg =~ /-docs?$/ && $arch ne 'all') {
 110         tag 'documentation-package-not-architecture-independent';
 111     }
 112 }
 113
 114 # Read build-depends file and see if it depends on autotools-dev or automake.
 115 my $atdinbd = $info->relation('build-depends')->implies($AUTOTOOLS);
 116
 117 # Create a closure so that we can pass our lexical variables into the find
 118 # wanted function.  We don't want to make them global because we'll then leak
 119 # that data across packages in a large Maemian run.
 120 my %warned;
 121 my $format = $info->field('format');
 122 if ($format =~ /^\s*2\.0\s*\z/ or $format =~ /^\s*3\.0\s*\(quilt\)/) {
 123     my $wanted = sub { check_debfiles($pkg, $info, \%warned) };
 124     find($wanted, 'debfiles');
 125 } elsif (not $info->native) {
 126     check_diffstat("diffstat", \%warned);
 127 }
 128 my $wanted = sub { find_cruft($pkg, $info, \%warned, $atdinbd) };
 129 find($wanted, 'unpacked');
 130
 131 # Look for cruft based on file's results, but allow cruft in test directories
 132 # where it may be part of a test suite.
 133 my $file_info = $info->file_info;
 134 for my $file (keys(%$file_info)) {
 135     next if ($file =~ m,(?:^|/)t(?:est(?:s(?:et)?)?)?/,);
 136     if ($file_info->{$file} =~ m/\bELF\b/) {
 137         tag "source-contains-prebuilt-binary", $file;
 138     } elsif ($file_info->{$file} =~ m/\bPE(32|64)\b/) {
 139         tag "source-contains-prebuilt-windows-binary", $file;
 140     }
 141 }
 142
 143 # Report any error messages from tar while unpacking the source package if it
 144 # isn't just tar cruft.
 145 for my $file (keys %ERRORS) {
 146     my $tag = $ERRORS{$file};
 147     if (-s $file) {
 148         open(ERRORS, '<', $file) or fail("cannot open $file: $!");
 149         local $_;
 150         while (<ERRORS>) {
 151             chomp;
 152             s,^(?:[/\w]+/)?tar: ,,;
 153
 154             # Record size errors are harmless.  Skipping to next header
 155             # apparently comes from star files.  Ignore all GnuPG noise from
 156             # not having a valid GnuPG configuration directory.  Also ignore
 157             # the tar "exiting with failure status" message, since it comes
 158             # after some other error.
 159             next if /^Record size =/;
 160             next if /^Skipping to next header/;
 161             next if /^gpgv?: /;
 162             next if /^secmem usage: /;
 163             next if /^Exiting with failure status due to previous errors/;
 164             tag $tag, $_;
 165         }
 166         close ERRORS;
 167     }
 168 }
 169
 170 } # </run>
 171
 172 # -----------------------------------
 173
 174 # Check the diff for problems.  Record any files we warn about in $warned so
 175 # that we don't warn again when checking the full unpacked source.  Takes the
 176 # name of a file containing diffstat output.
 177 sub check_diffstat {
 178     my ($diffstat, $warned) = @_;
 179     my $saw_file;
 180     open(STAT, '<', $diffstat) or fail("cannot open $diffstat: $!");
 181     local $_;
 182     while (<STAT>) {
 183         my ($file) = (m,^\s+(.*?)\s+\|,)
 184             or fail("syntax error in diffstat file: $_");
 185         $saw_file = 1;
 186
 187         # Check for CMake cache files.  These embed the source path and hence
 188         # will cause FTBFS on buildds, so they should never be touched in the
 189         # diff.
 190         if ($file =~ m,(^|/)CMakeCache.txt\z,) {
 191             tag 'diff-contains-cmake-cache-file', $file;
 192         }
 193
 194         # For everything else, we only care about diffs that add files.  If
 195         # the file is being modified, that's not a problem with the diff and
 196         # we'll catch it later when we check the source.  This regex doesn't
 197         # catch only file adds, just any diff that doesn't remove lines from a
 198         # file, but it's a good guess.
 199         next unless m,\|\s+\d+\s+\++$,;
 200
 201         # diffstat output contains only files, but we consider the directory
 202         # checks to trigger if the diff adds any files in those directories.
 203         my ($directory) = ($file =~ m,^(.*)/[^/]+$,);
 204         if ($directory and not $warned->{$directory}) {
 205             for my $rule (@directory_checks) {
 206                 if ($directory =~ /$rule->[0]/) {
 207                     tag "diff-contains-$rule->[1]", $directory;
 208                     $warned->{$directory} = 1;
 209                 }
 210             }
 211         }
 212
 213         # Now the simpler file checks.
 214         for my $rule (@file_checks) {
 215             if ($file =~ /$rule->[0]/) {
 216                 tag "diff-contains-$rule->[1]", $file;
 217                 $warned->{$file} = 1;
 218             }
 219         }
 220
 221         # Additional special checks only for the diff, not the full source.
 222         if ($file =~ m,^debian/substvars$,) {
 223             tag 'diff-contains-substvars', $file;
 224         }
 225     }
 226     close(STAT) or fail("error reading diffstat file: $!");
 227
 228     # If there was nothing in the diffstat output, there was nothing in the
 229     # diff, which is probably a mistake.
 230     tag 'empty-debian-diff' unless $saw_file;
 231 }
 232
 233 # Check the debian directory for problems.  This is used for Format: 2.0 and
 234 # 3.0 (quilt) packages where there is no Debian diff and hence no diffstat
 235 # output.  Record any files we warn about in $warned so that we don't warn
 236 # again when checking the full unpacked source.
 237 sub check_debfiles {
 238     my ($pkg, $info, $warned) = @_;
 239     (my $name = $File::Find::name) =~ s,^(\./)?debfiles/,,;
 240
 241     # Check for unwanted directories and files.  This really duplicates the
 242     # find_cruft function and we should find a way to combine them.
 243     if (-d) {
 244         for my $rule (@directory_checks) {
 245             if ($name =~ /$rule->[0]/) {
 246                 tag "diff-contains-$rule->[1]", "debian/$name";
 247                 $warned->{"debian/$name"} = 1;
 248             }
 249         }
 250     }
 251     -f or return;
 252     for my $rule (@file_checks) {
 253         if ($name =~ /$rule->[0]/) {
 254             tag "diff-contains-$rule->[1]", "debian/$name";
 255             $warned->{"debian/$name"} = 1;
 256         }
 257     }
 258
 259     # Additional special checks only for the diff, not the full source.
 260     if ($name eq 'substvars') {
 261         tag 'diff-contains-substvars', "debian/$name";
 262     }
 263 }
 264
 265 # Check each file in the source package for problems.  By the time we get to
 266 # this point, we've already checked the diff and warned about anything added
 267 # there, so we only warn about things that weren't in the diff here.
 268 #
 269 # Report problems with native packages using the "diff-contains" rather than
 270 # "source-contains" tag.  The tag isn't entirely accurate, but it's better
 271 # than creating yet a third set of tags, and this gets the severity right.
 272 sub find_cruft {
 273     my ($pkg, $info, $warned, $atdinbd) = @_;
 274     (my $name = $File::Find::name) =~ s,^(\./)?unpacked/,,;
 275
 276     # Ignore files in test suites.  They may be part of the test.
 277     if (-d and m,^t(?:est(?:s(?:et)?)?)?\z,) {
 278         $File::Find::prune = 1;
 279         return;
 280     }
 281
 282     my $prefix = ($info->native ? "diff-contains" : "source-contains");
 283     if (-d and not $warned->{$name}) {
 284         for my $rule (@directory_checks) {
 285             if ($name =~ /$rule->[0]/) {
 286                 tag "${prefix}-$rule->[1]", $name;
 287             }
 288         }
 289     }
 290     -f or return; # we just need normal files for the rest
 291
 292     unless ($warned->{$name}) {
 293         for my $rule (@file_checks) {
 294             next if ($rule->[2] and not $info->native);
 295             if ($name =~ /$rule->[0]/) {
 296                 tag "${prefix}-$rule->[1]", $name;
 297             }
 298         }
 299     }
 300
 301     # Tests of autotools files are a special case.  Ignore debian/config.cache
 302     # as anyone doing that probably knows what they're doing and is using it
 303     # as part of the build.
 304     if ($name =~ m,^(.+/)?config.(?:cache|log|status)$,) {
 305         if ($name !~ m,^debian/config\.cache$,) {
 306             tag "configure-generated-file-in-source", $name;
 307         }
 308     } elsif ($name =~ m,^(.+/)?config.(?:guess|sub)$, and not $atdinbd) {
 309         my $b = basename $name;
 310         open (F, '<', $b) or die "can't open $name: $!";
 311         while (<F>) {
 312             last if $. > 10; # it's on the 6th line, but be a bit more lenient
 313             if (/^(?:timestamp|version)='((\d+)-(\d+).*)'$/) {
 314                 my ($date, $year, $month) = ($1, $2, $3);
 315                 if ($year < 2004) {
 316                     tag 'ancient-autotools-helper-file', $name, $date;
 317                 } elsif (($year < 2006) or ($year == 2006 and $month < 6)) {
 318                     tag 'outdated-autotools-helper-file', $name, $date;
 319                 }
 320             }
 321         }
 322         close F;
 323     } elsif ($name =~ m,^(.+/)?ltconfig$,) {
 324         tag "ancient-libtool", $name;
 325     } elsif ($name =~ m,^(.+/)?ltmain\.sh$,) {
 326         my $b = basename $name;
 327         open (F, '<', $b) or die "can't open $name: $!";
 328         while (<F>) {
 329             if (/^VERSION=[\"\']?(1\.(\d)\.(\d+)(?:-(\d))?)/) {
 330                 my ($version, $major, $minor, $debian) = ($1, $2, $3, $4);
 331                 if ($major < 5 or ($major == 5 and $minor < 2)) {
 332                     tag "ancient-libtool", $name, $version;
 333                 } elsif ($minor == 2 and (!$debian or $debian < 2)) {
 334                     tag "ancient-libtool", $name, $version;
 335                 } elsif ($minor < 24) {
 336                     # not entirely sure whether that would be good idea
 337 #                    tag "outdated-libtool", $name, $version;
 338                 }
 339                 last;
 340             }
 341         }
 342         close F;
 343     }
 344 }
 345
 346 1;
 347
 348 # Local Variables:
 349 # indent-tabs-mode: nil
 350 # cperl-indent-level: 4
 351 # End:
 352 # vim: ts=8 sw=4 noet syntax=perl