Главная   Изменения   Спек   Патчи   Исходники   Загрузить   Gear   Bugs and FR  Repocop 

#!/usr/bin/perl

=head1	NAME

srpmcmp - compare source RPM packages

=head1	SYNOPSIS

srpmcmp [options] package-v1.src.rpm package-v2.src.rpm

=head1	DESCRIPTION

This perl script compares the contents of two source RPM packages in unified
diff format.

=head1	OPTIONS

=over

=item	--verbose

Explain autocrap and RCS removal (see below).

=item	--deep

Compare also source trees (by default, only top-level files like spec-files and
patches are compared).

=item	--autocrap

Compare also files automatically generated with GNU autotools.
Files with the following names are examnied:

	aclocal.m4
	configure
	config.guess
	config.h.in
	config.rpath
	config.sub
	depcomp
	install-sh
	ltmain.sh
	Makefile.in
	Makefile
	missing
	mkinstalldirs
	texinfo.tex

=item	--rcs

Keep RCS tags intact.  Those are unexpanded by default.
Here is a list of RCS keywords (according to C<cvs.info>):

	Author
	Date
	Header
	Id
	Name
	Locker
	Log
	RCSfile
	Revision
	Source
	State

=back

=head1	COPYING

Copyright (c) 2003, 2004.  Alexey Tourbin <at@altlinux.org>.  All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

use strict;

use Getopt::Long qw(GetOptions);
GetOptions verbose => \my $opt_verbose,
	deep => \my $opt_deep, autocrap => \my $opt_autocrap, rcs => \my $opt_rcs;

use Cwd qw(getcwd realpath);
my $saved_cwd = getcwd();
use sigtrap qw(die normal-signals);

sub fatal {
	chdir $saved_cwd;
	die "$0: @_\n";
}

sub verbose {
	print STDERR "@_\n" if $opt_verbose;
}

sub tmp_unpack ($) {
	use File::Temp qw(tempdir);

	my $rpm = shift;
	my $dir = tempdir("srpmcmp.XXXXXXXXXX", TMPDIR => 1, CLEANUP => 1);
	chdir $dir;
	my $rv = system qq(rpm2cpio '$rpm' | cpio -idmu --quiet --no-absolute-filenames);
	fatal "`rpm2cpio $rpm' failed" if $rv;
	return $dir;
}

sub uncompress ($) {
	my $dir = shift;
	chdir $dir;

	if (my @gz = (<*.gz>, <*.tgz>)) {
		my $rv = system qw(gzip -df) => @gz;
		fatal "`gzip -df @gz' failed" if $rv;
	}
	if (my @bz2 = <*.bz2>) {
		my $rv = system qw(bzip2 -df) => @bz2;
		fatal "`bzip2 -df @bz2' failed" if $rv;
	}
	if (my @xz = <*.xz>) {
		my $rv = system qw(xz -df) => @xz;
		fatal "`xz -df @xz' failed" if $rv;
	}
	foreach (<*.tar>) {
		my $rv = system qw(tar -xf) => $_;
		fatal "`tar -xf $_' failed" if $rv;
		unlink;
	}
}

sub cleanup ($) {
	my $dir = shift;
	chdir $dir;

	sub kill_autocrap {
		my %crap = (
			"aclocal.m4" => [
				"# generated automatically by aclocal",
				"dnl aclocal.m4 generated automatically by aclocal",
			],
			"configure" => [
				"# Generated by GNU Autoconf",
				"# Generated automatically using autoconf",
			],
			"config.guess" => [
				"# Attempt to guess a canonical system name",
			],
			"config.h.in" => [
				"/* config.h.in.  Generated automatically from configure.in by autoheader",
				"/* config.h.in.  Generated from configure.in by autoheader",
			],
			"config.rpath" => [
				"# Output a system dependent set of variables",
			],
			"config.sub" => [
				"# Configuration validation subroutine script",
			],
			"depcomp" => [
				"# depcomp - compile a program generating dependencies",
			],
			"install-sh" => [
				"# install - install a program, script, or datafile",
			],
			"ltmain.sh" => [
				"# ltmain.sh - Provide generalized library-building support services",
			],
			"Makefile.in" => [
				"# Makefile.in generated by automake",
				"# Makefile.in generated automatically by automake",
			],
			"Makefile" => [
				"# Generated automatically from Makefile.in",
			],
			"missing" => [
				"# Common stub for a few missing GNU programs while installing",
			],
			"mkinstalldirs" => [
				"# mkinstalldirs --- make directory hierarchy",
			],
			"texinfo.tex" => [
				"% texinfo.tex -- TeX macros to handle Texinfo files"
			],
		);

		my $fname = $_;
		return unless $crap{$fname};
		return unless open my $fh, $fname;
		while (my $line = <$fh>) {
			last if $. > 9;
			if (grep { index($line, $_) == 0 } @{$crap{$fname}}) {
				unlink $fname;
				verbose "removed $File::Find::name (autocrap)";
			}
		}
	}
	sub kill_rcs {
		my $fname = $_;
		my $keywords = qr(Author|Date|Header|Id|Name|Locker|Log|RCSfile|Revision|Source|State);

		open my $fh, "+<", $fname
			or return;
		my ($atime, $mtime) = (stat $fh)[7,9];
		local $/ = undef;
		local $_ = <$fh>;
		if (s/\$($keywords):.*?\$/\$$1\$/go) {
			verbose "unexpanded RCS tags in $File::Find::name";
			seek $fh, 0, 0;
			print $fh $_;
			truncate $fh, tell $fh;
			utime $atime, $mtime => $fname;
		}
	}
	sub wanted {
		-f || return;
		&kill_autocrap	unless $opt_autocrap;
		&kill_rcs	unless $opt_rcs;
	}

	use File::Find qw(find);
	find \&wanted => ".";
}

sub cmp_rm ($$) {
	my ($f1, $f2) = @_;
	my $rv;
	if (-e $f1 && -e $f2) {
		local $ENV{LC_ALL} = "C";
		local $ENV{TZ} = "UTC0";
		$rv = `diff -abBpruw $f1 $f2`;
		system qw(rm -rf) => $f1, $f2;
	}
	return $rv;
}

sub _cmp_eq ($$) {
	return $_[0] eq $_[1];
}

sub _cmp_ver ($$) {
	my ($ver1, $ver2) = @_;
	foreach ($ver1, $ver2) {
		s/rc\d//ig;
		s/pre\d//ig;
		s/[^a-z]//g;
	}
	return $ver1 eq $ver2;
}

sub same_type ($$) {
	my ($f1, $f2) = @_;
	return "f" if -f $f1 && -f $f2;
	return "d" if -d $f1 && -d $f2 && $opt_deep;
	return;
}

sub supercmp ($$$) {
	my ($dir1, $dir2, $glob) = @_;
	my $diff;
try:	while (1) {
		foreach my $cmp_func (\&_cmp_eq, \&_cmp_ver) {
			chdir $dir1; my @f1 = glob($glob);
			foreach my $f1 (@f1) {
				chdir $dir2; my @f2 = glob($glob);
				foreach my $f2 (@f2) {
					if ($cmp_func->($f1, $f2) && same_type("$dir1/$f1", "$dir2/$f2")) {
						$diff .= cmp_rm "$dir1/$f1", "$dir2/$f2";
						next try;
					}
				}
			}
		}
		last;
	}
	return $diff;
}

sub srpmcmp ($$) {
	my ($rpm1, $rpm2) = map { realpath($_) } @_;

	my $dir1 = tmp_unpack $rpm1; uncompress $dir1; cleanup $dir1;
	my $dir2 = tmp_unpack $rpm2; uncompress $dir2; cleanup $dir2;

	my $diff = supercmp($dir1, $dir2, "*.spec")
		. supercmp($dir1, $dir2, "*.patch")
		. supercmp($dir1, $dir2, "*.diff")
		. supercmp($dir1, $dir2, "*.init")
		. supercmp($dir1, $dir2, "*.menu")
		. supercmp($dir1, $dir2, "*")
		. "End of diff\n\n";

# see the rest
	my $rest1 = `/bin/ls -AF $dir1`;
	$diff .= "Files not compared in $dir1:\n$rest1\n" if $rest1 =~ /\S/;
	my $rest2 = `/bin/ls -AF $dir2`;
	$diff .= "Files not compared in $dir2:\n$rest2\n" if $rest2 =~ /\S/;

# filter out temporary directories
	for ($rpm1, $rpm2) {
		s/.*\///;
		s/\.src\.rpm$//;
	}
	$diff =~ s/\Q$dir1/$rpm1/g;
	$diff =~ s/\Q$dir2/$rpm2/g;
	return $diff;
}

@ARGV == 2 and -f $ARGV[0] and -f $ARGV[1] or print <<EOF and exit 1;
usage:
$0 [--deep] [--autocrap] [--rcs] package1.src.rpm package2.src.rpm
See srpmcmp(1) for details.
EOF

print srpmcmp $ARGV[0], $ARGV[1];
chdir $saved_cwd;