#!/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): Author Date Header Id Name Locker Log RCSfile Revision Source State =back =head1 COPYING Copyright (c) 2003, 2004. Alexey Tourbin . 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 <