# 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 warnings; use Lintian::Data; use Lintian::Relation (); use Lintian::Tags qw(tag); 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. 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. our $AUTOTOOLS = Lintian::Relation->new (join (' | ', Lintian::Data->new ('cruft/autotools')->all)); our $LIBTOOL = Lintian::Relation->new ('libtool | dh-autoreconf'); # The files that contain error messages from tar, which we'll check and issue # tags for if they contain something unexpected, and their corresponding tags. our %ERRORS = ('index-errors' => 'tar-errors-from-source', 'unpacked-errors' => 'tar-errors-from-source'); # 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,^(.+/)?\.hgtags$, => 'hg-tags-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 ], ); # List of files to check for a LF-only end of line terminator, relative # to the debian/ source directory our @EOL_TERMINATORS_FILES = qw(control changelog); sub run { my $pkg = shift; my $type = shift; my $info = shift; my $droot = $info->debfiles; if (-e "$droot/files" and not -z "$droot/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. my $version = $info->field('version'); # If the version field is missing, assume it to be a native, # maintainer upload as it is probably the most likely case. $version = '0-1' unless defined $version; if ($info->native) { if ($version =~ /-/ and $version !~ /-0\.[^-]+$/) { tag 'native-package-with-dash-version'; } } else { if ($version !~ /-/) { tag 'non-native-package-with-native-version'; } } # Check if the package build-depends on autotools-dev, automake, or libtool. my $atdinbd = $info->relation ('build-depends-all')->implies ($AUTOTOOLS); my $ltinbd = $info->relation ('build-depends-all')->implies ($LIBTOOL); # Create a closure so that we can pass our lexical variables into the find # wanted function. We don't want to make them global because we'll then leak # that data across packages in a large Lintian run. my %warned; my $format = $info->field('format'); # Assume the package to be non-native if the field is not present. # - while 1.0 is more likely in this case, Lintian will probably get # better results by checking debfiles/ rather than looking for a diffstat # that may not be present. $format = '3.0 (quilt)' unless defined $format; if ($format =~ /^\s*2\.0\s*\z/ or $format =~ /^\s*3\.0\s*\(quilt\)/) { my $wanted = sub { check_debfiles($pkg, $info, qr/\Q$droot\E/, \%warned) }; find($wanted, $droot); } elsif (not $info->native) { check_diffstat($info->diffstat, \%warned); } my $uroot = $info->unpacked; my $abs = Cwd::abs_path ("$uroot/") or fail "abs_path $uroot: $!"; $abs =~ s,/$,,; # remove the trailing slash if any my $wanted = sub { find_cruft($pkg, $info, qr/\Q$abs\E/, \%warned, $atdinbd, $ltinbd) }; find($wanted, $abs); # Look for cruft based on file's results, but allow cruft in test directories # where it may be part of a test suite. my $file_info = $info->file_info; for my $file (keys(%$file_info)) { next if ($file =~ m,(?:^|/)t(?:est(?:s(?:et)?)?)?/,); if ($file_info->{$file} =~ m/\bELF\b/) { tag 'source-contains-prebuilt-binary', $file; } elsif ($file_info->{$file} =~ m/\b(?:PE(?:32|64)|COFF executable)\b/) { tag 'source-contains-prebuilt-windows-binary', $file; } elsif ($file =~ /\bwaf$/) { my $ok = 1; # If file believes this is data, then we trust that $ok = 0 if $file_info->{$file} =~ m/data/; if ($ok) { # Unfortunately file 5.04 (Squeeze) and 5.09 does not # always agree, so manually check for the bz2 entry if # file does not declare it as "data". my $path = $info->unpacked ($file); my $marker = 0; next unless -f $path and not -l $path; open my $fd, '<', $path or fail "Opening $file: $!"; while ( my $line = <$fd> ) { next unless $line =~ m/^#/o; if ($marker && $line =~ m/^#BZ[h0][0-9]/o) { $ok = 0; last; } $marker = 1 if $line =~ m/^#==>/o; # We could probably stop here, but just in case $marker = 0 if $line =~ m/^#<==/o; } close $fd; } tag 'source-contains-waf-binary', $file unless $ok; } } for my $file (@EOL_TERMINATORS_FILES) { $file = "debian/$file"; next unless defined $file_info->{$file}; tag 'control-file-with-CRLF-EOLs', $file if ($file_info->{$file} =~ m/\bCRLF\b/); } # Report any error messages from tar while unpacking the source package if it # isn't just tar cruft. for my $file (keys %ERRORS) { my $tag = $ERRORS{$file}; if (-s $file) { open(ERRORS, '<', $file) or fail("cannot open $file: $!"); local $_; while () { chomp; s,^(?:[/\w]+/)?tar: ,,; # Record size errors are harmless. Skipping to next header # apparently comes from star files. Ignore all GnuPG noise from # not having a valid GnuPG configuration directory. Also ignore # the tar "exiting with failure status" message, since it comes # after some other error. next if /^Record size =/; next if /^Skipping to next header/; next if /^gpgv?: /; next if /^secmem usage: /; next if /^Exiting with failure status due to previous errors/; tag $tag, $_; } close ERRORS; } } } # # ----------------------------------- # 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. sub check_diffstat { my ($diffstat, $warned) = @_; my $saw_file; open(STAT, '<', $diffstat) or fail("cannot open $diffstat: $!"); local $_; while () { my ($file) = (m,^\s+(.*?)\s+\|,) or fail("syntax error in diffstat file: $_"); $saw_file = 1; # Check for CMake cache files. These embed the source path and hence # will cause FTBFS on buildds, so they should never be touched in the # diff. if ($file =~ m,(?:^|/)CMakeCache.txt\z, and $file !~ m,(?:^|/)debian/,) { tag 'diff-contains-cmake-cache-file', $file; } # For everything else, 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: $!"); # If there was nothing in the diffstat output, there was nothing in the # diff, which is probably a mistake. tag 'empty-debian-diff' unless $saw_file; } # Check the debian directory for problems. This is used for Format: 2.0 and # 3.0 (quilt) packages where there is no Debian diff and hence no diffstat # output. Record any files we warn about in $warned so that we don't warn # again when checking the full unpacked source. sub check_debfiles { my ($pkg, $info, $droot, $warned) = @_; (my $name = $File::Find::name) =~ s,^$droot/,,; # Check for unwanted directories and files. This really duplicates the # find_cruft function and we should find a way to combine them. if (-d) { for my $rule (@directory_checks) { if ($name =~ /$rule->[0]/) { tag "diff-contains-$rule->[1]", "debian/$name"; $warned->{"debian/$name"} = 1; } } } -f or return; for my $rule (@file_checks) { if ($name =~ /$rule->[0]/) { tag "diff-contains-$rule->[1]", "debian/$name"; $warned->{"debian/$name"} = 1; } } # Additional special checks only for the diff, not the full source. if ($name =~ m@^(?:.+\.)?substvars$@o) { tag 'diff-contains-substvars', "debian/$name"; } } # 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 ($pkg, $info, $root, $warned, $atdinbd, $ltinbd) = @_; (my $name = $File::Find::name) =~ s,^$root/,,; # Ignore the .pc directory and its contents, created as part of the # unpacking of a 3.0 (quilt) source package. if (-d and $_ eq '.pc') { $File::Find::prune = 1; return; } # Ignore files in test suites. They may be part of the test. if (-d and m,^t(?:est(?:s(?:et)?)?)?\z,) { $File::Find::prune = 1; return; } 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; } } } -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; } } } # 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$,) { 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+)-(\d+).*)'$/) { my ($date, $year, $month) = ($1, $2, $3); if ($year < 2004) { tag 'ancient-autotools-helper-file', $name, $date; } elsif (($year < 2006) or ($year == 2006 and $month < 6)) { tag 'outdated-autotools-helper-file', $name, $date; } } } close F; } elsif ($name =~ m,^(.+/)?ltconfig$, and not $ltinbd) { tag 'ancient-libtool', $name; } elsif ($name =~ m,^(.+/)?ltmain\.sh$, and not $ltinbd) { my $b = basename $name; open (F, '<', $b) or die "can't open $name: $!"; while () { if (/^VERSION=[\"\']?(1\.(\d)\.(\d+)(?:-(\d))?)/) { my ($version, $major, $minor, $debian) = ($1, $2, $3, $4); if ($major < 5 or ($major == 5 and $minor < 2)) { tag 'ancient-libtool', $name, $version; } elsif ($minor == 2 and (!$debian || $debian < 2)) { tag 'ancient-libtool', $name, $version; } elsif ($minor < 24) { # not entirely sure whether that would be good idea # tag "outdated-libtool", $name, $version; } last; } } close F; } } 1; # Local Variables: # indent-tabs-mode: nil # cperl-indent-level: 4 # End: # vim: syntax=perl sw=4 sts=4 sr et