# patch-systems -- lintian check script -*- perl -*-
#
# Copyright (C) 2007 Marc Brockschmidt
# Copyright (C) 2008 Raphael Hertzog
#
# 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::patch_systems;
use strict;

use Lintian::Tags qw(tag);
use Util;
use Cwd qw(realpath);

sub run {
	my ($pkg, $type, $info) = @_;

	unless (-d "fields") {
    	fail("directory in lintian laboratory for $type package $pkg missing: fields");
	}

	#Some (cruft) checks are valid for every patch system, so we need to record that:
	my $uses_patch_system = 0;

	#Get build deps so we can decide which build system the maintainer
	#meant to use:
	my $build_deps = $info->relation('build-depends-all');
	# Get source package format
	my $format = "";
	if (defined $info->field('format')) {
		$format = $info->field('format');
	}
	my $quilt_format = ($format =~ /3\.\d+ \(quilt\)/) ? 1 : 0;

	my $cwd = realpath('.');

	#----- dpatch
	if ($build_deps->implies("dpatch")) {
		$uses_patch_system++;
		#check for a debian/patches file:
		if (! -r "debfiles/patches/00list") {
			tag "dpatch-build-dep-but-no-patch-list";
		} else {
			my $list_uses_cpp = 0;
			if (open(OPTS, '<', "debfiles/patches/00options")) {
				while(<OPTS>) {
					if (/DPATCH_OPTION_CPP=1/) {
						$list_uses_cpp = 1;
						last;
					}
				}
				close(OPTS);
			}
			foreach my $listfile (glob("debfiles/patches/00list*")) {
				my @patches;
				if (open(IN, '<', "$listfile")) {
					while(<IN>) {
						chomp;
						next if (/^\#/); #ignore comments or CPP directive
						s%//.*%% if $list_uses_cpp; # remove C++ style comments
						if ($list_uses_cpp && m%/\*%) {
							# remove C style comments
							$_ .= <IN> while($_ !~ m%\*/%);
							s%/\*[^*]*\*/%%g;
						}
						next if (/^\s*$/); #ignore blank lines
						push @patches, split(' ', $_);
					}
					close(IN);
				}

				# Check each patch.
				foreach my $patch_file (@patches) {
					$patch_file .= ".dpatch" if -e "debfiles/patches/$patch_file.dpatch"
						and not -e "debfiles/patches/$patch_file";
					next if ( -l "debfiles/patches/$patch_file" );
					unless (realpath("debfiles/patches/$patch_file") =~ m,^\Q$cwd\E/debfiles/,) {
					    next;
					}
					if (! -r "debfiles/patches/$patch_file") {
						tag "dpatch-index-references-non-existent-patch", $patch_file;
						next;
					}
					if (open(PATCH_FILE, '<', "debfiles/patches/$patch_file")) {
						my $has_comment = 0;
						while (<PATCH_FILE>) {
							#stop if something looking like a patch starts:
							last if /^---/;
							#note comment if we find a proper one
							$has_comment = 1 if (/^\#+\s*DP:\s*(\S.*)$/ && $1 !~ /^no description\.?$/i);
							$has_comment = 1 if (/^\# (?:Description|Subject)/);
						}
						close(PATCH_FILE);
						unless ($has_comment) {
							tag "dpatch-missing-description", $patch_file;
						}
					}
					check_patch($patch_file);
				}
			}
		}
	}

	#----- quilt
	if ($build_deps->implies("quilt") or $quilt_format) {
		$uses_patch_system++;
		#check for a debian/patches file:
		if (! -r "debfiles/patches/series") {
			tag "quilt-build-dep-but-no-series-file" unless $quilt_format;
		} else {
			if (open(IN, '<', "debfiles/patches/series")) {
				my @patches;
				my @badopts;
				while(<IN>) {
					chomp; s/^\s+//; s/\s+$//; # Strip leading/trailing spaces
					s/(^|\s+)#.*$//; # Strip comment
					next unless $_;
					if (/^(\S+)\s+(\S.*)$/) {
						$_ = $1;
						if ($2 ne '-p1') {
							push @badopts, $_;
						}
					}
					push @patches, $_;
				}
				close(IN);
				if (scalar(@badopts)) {
					tag "quilt-patch-with-non-standard-options", @badopts;
				}

				# Check each patch.
				foreach my $patch_file (@patches) {
					next if ( -l "debfiles/patches/$patch_file" );
					unless (realpath("debfiles/patches/$patch_file") =~ m,^\Q$cwd\E/debfiles/,) {
					    next;
					}
					if (! -r "debfiles/patches/$patch_file") {
						tag "quilt-series-references-non-existent-patch", $patch_file;
						next;
					}
					if (open(PATCH_FILE, '<', "debfiles/patches/$patch_file")) {
						my $has_description = 0;
						while (<PATCH_FILE>) {
							# stop if something looking like a patch starts:
							last if /^---/;
							next if /^\s*$/;
							# Skip common "lead-in" lines
							$has_description = 1 unless (/^(Index: |=+$|diff .+|index )/);
						}
						close(PATCH_FILE);
						unless ($has_description) {
							tag "quilt-patch-missing-description", $patch_file;
						}
					}
					check_patch($patch_file);
				}
			}
		}
	} else {
		if (-r "debfiles/patches/series" and
		    -f "debfiles/patches/series") {
			# 3.0 (quilt) sources don't need quilt as dpkg-source will do the work
			tag "quilt-series-but-no-build-dep" unless $quilt_format;
		}
	}

	#----- look for README.source
	if ($uses_patch_system && ! $quilt_format && ! -f 'debfiles/README.source') {
		tag "patch-system-but-no-source-readme";
	}

	#----- general cruft checking:
	if ($uses_patch_system > 1) {
		tag "more-than-one-patch-system";
	}
	my @direct;
	open(STAT, '<', "diffstat") or fail("cannot open diffstat file: $!");
	while (<STAT>) {
		my ($file) = (m,^\s+(.*?)\s+\|,)
		     or fail("syntax error in diffstat file: $_");
		push (@direct, $file) if ($file !~ m,^debian/,);
	}
	close (STAT) or fail("error reading diffstat file: $!");
	if (@direct) {
		my $files = (@direct > 1) ? "$direct[0] and $#direct more" : $direct[0];

		tag "patch-system-but-direct-changes-in-diff", $files
			if ($uses_patch_system);
		tag "direct-changes-in-diff-but-no-patch-system", $files
			if (not $uses_patch_system);
	}
}

# Checks on patches common to all build systems.
sub check_patch($) {
	my $patch_file = shift;

	# Use -p1 to strip off the first layer of directory in case the parent
	# directory in which the patches were generated was named "debian".
	# This will produce false negatives for -p0 patches that modify files
	# in the debian/* directory, but as of 2010-01-01, all cases where the
	# first level of the patch path is "debian/" in the archive are false
	# positives.
	open(DIFFSTAT, "-|", 'diffstat', '-p1', '-l', "debfiles/patches/$patch_file")
	  or fail("can't fork diffstat");
	while (<DIFFSTAT>) {
		chomp;
		if (m|^(\./)?debian/|) {
			tag "patch-modifying-debian-files", $patch_file, $_;
		}
	}
	close(DIFFSTAT) or fail("cannot close pipe to diffstat on $patch_file: $!");
}

1;

# Local Variables:
# indent-tabs-mode: t
# cperl-indent-level: 8
# End:
# vim: syntax=perl sw=4 ts=4 noet shiftround