# 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) = @_;

	#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 $droot = realpath($info->debfiles);
	my $dpdir = "$droot/patches";

	#----- dpatch
	if ($build_deps->implies("dpatch")) {
		$uses_patch_system++;
		#check for a debian/patches file:
		if (! -r "$dpdir/00list") {
			tag 'dpatch-build-dep-but-no-patch-list';
		} else {
			my $list_uses_cpp = 0;
			if (open(OPTS, '<', "$dpdir/00options")) {
				while(<OPTS>) {
					if (/DPATCH_OPTION_CPP=1/) {
						$list_uses_cpp = 1;
						last;
					}
				}
				close(OPTS);
			}
			foreach my $listfile (glob("$dpdir/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 "$dpdir/$patch_file.dpatch"
						and not -e "$dpdir/$patch_file";
					next if ( -l "$dpdir/$patch_file" );
					unless (realpath("$dpdir/$patch_file") =~ m,^\Q$droot/,) {
					    next;
					}
					if (! -r "$dpdir/$patch_file") {
						tag 'dpatch-index-references-non-existent-patch', $patch_file;
						next;
					}
					if (open(PATCH_FILE, '<', "$dpdir/$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($dpdir, $patch_file);
				}
			}
		}
	}

	#----- quilt
	if ($build_deps->implies("quilt") or $quilt_format) {
		$uses_patch_system++;
		if($quilt_format && $build_deps->implies("quilt")){
		    tag "unneeded-build-dep-on-quilt";
		}
		#check for a debian/patches file:
		if (! -r "$dpdir/series") {
			tag 'quilt-build-dep-but-no-series-file' unless $quilt_format;
		} else {
			if (open(IN, '<', "$dpdir/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 "$dpdir/$patch_file" );
					unless (realpath("$dpdir/$patch_file") =~ m,^\Q$droot\E/,) {
					    next;
					}
					if (! -r "$dpdir/$patch_file") {
						tag 'quilt-series-references-non-existent-patch', $patch_file;
						next;
					}
					if (open(PATCH_FILE, '<', "$dpdir/$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($dpdir, $patch_file);
				}
			}
		}
		if ($quilt_format) { # 3.0 (quilt) specific checks
		    # Format 3.0 packages may generate a debian-changes-$version patch
		    my $version = $info->field('version');
		    if (-f "$dpdir/debian-changes-$version" &&
			! -f "$droot/source/patch-header") {
			tag 'format-3.0-but-debian-changes-patch';
		    }
		}
	} else {
		if (-r "$dpdir/series" and
		    -f "$dpdir/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 "$droot/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, '<', $info->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 ($dpdir, $patch_file) = @_;

	# Use --strip=1 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 --strip=0 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(my $fd, '-|', 'lsdiff', '--strip=1', "$dpdir/$patch_file")
	  or fail('cannot fork lsdiff');
	while (<$fd>) {
		chomp;
		if (m|^(?:\./)?debian/|o) {
			tag 'patch-modifying-debian-files', $patch_file, $_;
		}
	}
	close($fd) or fail("cannot close pipe to lsdiff on $patch_file: $!");
}

1;

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