# 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'   ],
    );

# 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+|mine)$,     => '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 $pkg;
my $atdinbd;

sub run {

$pkg = shift;
my $type = 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.
open (VERSION, '<', "fields/version")
    or fail("cannot open fields/version: $!");
chomp(my $version = <VERSION>);
close VERSION;
$version =~ s/^\d+://; #Remove epoch
$native = (! -f "${pkg}_${version}.diff.gz");
if ($native and $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 = <IN>);
    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 = <IN>);
    close IN;
    $atdinbd = 1 if Dep::implies(Dep::parse($bd), Dep::parse($autotools_pkgs));
}

check_diffstat("diffstat");
find(\&find_cruft, 'unpacked');

} # </run>

# -----------------------------------

# 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 (<STAT>) {
        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 = ($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 $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 (<F>) {
            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
