#!/usr/bin/perl -w
# $Id: slack-diff 122 2006-09-27 07:34:32Z alan $
# vim:sw=2
# vim600:fdm=marker
# Copyright (C) 2004-2006 Alan Sundell <alan@sundell.net>
# All Rights Reserved. This program comes with ABSOLUTELY NO WARRANTY.
# See the file COPYING for details.
#
# This script is a wrapper for diff that gives output about special files
# and file modes. (diff can only compare regular files)
require 5.006;
use warnings FATAL => qw(all);
use strict;
use sigtrap qw(die untrapped normal-signals
stack-trace any error-signals);
use Errno;
use File::stat;
use File::Basename;
use File::Find;
use Getopt::Long;
use POSIX qw(SIGPIPE strftime);
use Fcntl qw(:mode); # provides things like S_IFMT that POSIX does not
my $VERSION = '0.1';
(my $PROG = $0) =~ s#.*/##;
my @diff; # diff program to use
my $exit = 0; # our exit code
sub compare ($$);
sub recursive_compare ($$);
sub filetype_to_string ($;$);
sub compare_files ($$);
sub diff ($$);
########################################
# Environment
# Helpful prefix to die messages
$SIG{__DIE__} = sub { die "FATAL[$PROG]: @_"; };
# Set a reasonable umask
umask 077;
# Autoflush on STDOUT
$|=1;
# Autoflush on STDERR
select((select(STDERR), $|=1)[0]);
# Default options
my %opt = (
fakediff => 1,
perms => 1,
'new-file' => 1,
diff => 'diff',
);
# Config and option parsing
my $usage = <<EOF;
Usage: $PROG [options] <file1> <file2>
$PROG -r <dir1> <dir2>
Options:
-u, -U NUM, --unified=NUM
Tell diff to use unified output format.
--diff PROG
Use this program for diffing, instead of "$opt{diff}"
--fakediff
Make a fake diff for file modes and other things that are not file
contents. Default is on, can be disabled with --nofakediff.
--perms
Care about owner, group, and permissions when doing fakediff.
Default is on, can be disabled with --noperms.
-r, --recursive
Recursively compare directories.
-N, --new-file
Treat missing files as empty. Default is on, can be disabled with
--nonew-file.
--unidirectional-new-file
Treat only missing files in the first directory as empty.
--from-file
Treat arguments as a list of files from which to read filenames to
compare, two lines at a time.
-0, --null
Use NULLs instead of newlines as the separator in --from-file mode
--devnullhack
You have a version of diff that can't deal with -N when not in
recursive mode, so we need to feed it /dev/null instead of the
missing file. Default is on, can be disabled with --nodevnullhack.
--version
Output version info
--help
Output this help text
Exit codes:
0 Found no differences
1 Found a difference
2 Had a serious error
3 Found a difference and had a serious error
EOF
{
Getopt::Long::Configure ("bundling");
GetOptions(\%opt,
'help|h|?',
'version',
'null|0',
'devnullhack',
'new-file|N',
'u',
'unified|U=i',
'recursive|r',
'from-file',
'unidirectional-new-file',
'fakediff!',
'perms!',
'diff=s',
) or die $usage;
if ($opt{help}) {
print $usage;
exit 0;
}
if ($opt{version}) {
print "$PROG version $VERSION\n";
exit 0;
}
}
if ($opt{diff}) {
# We split on spaces here to be useful -- so that people can give
# their diff options.
@diff = split(/\s+/, $opt{diff});
} else {
die "$PROG: No diff program!\n";
}
if ($opt{'u'}) {
push @diff, '-u';
} elsif ($opt{'unified'}) {
$opt{'u'} = 1; # We use this value later
push @diff, "--unified=$opt{'unified'}";
}
if (not $opt{'devnullhack'}) {
push @diff, '-N';
}
# usually, sigpipe would be someone quitting their pager, so don't sweat it
$SIG{PIPE} = sub { exit $exit };
if ($opt{'from-file'}) {
local $/ = "\0" if $opt{'null'};
while (my $old = <>) {
my $new = <>;
die "Uneven number of lines in --from-file mode!\n"
if not defined $new;
chomp($old);
chomp($new);
$exit |= compare($old, $new);
}
} else {
die $usage unless $#ARGV == 1;
$exit |= compare($ARGV[0], $ARGV[1]);
}
exit $exit;
##
# Subroutines
sub compare ($$) {
my ($old, $new) = @_;
if ($opt{recursive}) {
return recursive_compare($old, $new);
} else {
return compare_files($old, $new);
}
}
# compare two directories. We do this by walking down the *new*
# directory, and comparing everything that's there to the stuff in
# the old directory
sub recursive_compare ($$) {
my ($olddir, $newdir) = @_;
my ($retval, $basere, $wanted);
my (%seen);
$retval = 0;
if (-d $newdir) {
$basere = qr(^$newdir);
$wanted = sub {
my ($newfile) = $_;
my $oldfile = $newfile;
$oldfile =~ s#$basere#$olddir#;
$seen{$oldfile} = 1;
$retval |= compare_files($oldfile, $newfile);
};
eval { find({ wanted => $wanted , no_chdir => 1}, $newdir) };
if ($@) {
warn "$PROG: error during find: $@\n";
$retval |= 2;
}
}
return $retval
if $opt{'unidirectional-new-file'};
# If we're not unidirectional, we want to go through the old directory
# and diff any files we didn't see in the newdir.
if (-d $olddir) {
$basere = qr(^$olddir);
$wanted = sub {
my ($oldfile) = $_;
my $newfile;
return if $seen{$oldfile};
$newfile = $oldfile;
$newfile =~ s#$basere#$newdir#;
$retval |= compare_files($oldfile, $newfile);
};
eval { find({ wanted => $wanted , no_chdir => 1}, $olddir) };
if ($@) {
warn "$PROG: error during find: $@\n";
$retval |= 2;
}
}
return $retval;
}
# filetype_to_string(mode)
# filetype_to_string(mode, plural)
#
# Takes a mode returned from stat(), returns a noune describing the filetype,
# e.g. "directory", "symlink".
# If the "plural" argument is provided and true, returns the plural form of
# the noun, e.g. "directories", "symlinks".
sub filetype_to_string ($;$) {
my ($mode, $plural) = @_;
if (S_ISREG($mode)) {
return "regular file".($plural ? "s" : "");
} elsif (S_ISDIR($mode)) {
return "director".($plural ? "ies" : "y");
} elsif (S_ISLNK($mode)) {
return "symlink".($plural ? "s" : "");
} elsif (S_ISBLK($mode)) {
return "block device".($plural ? "s" : "");
} elsif (S_ISCHR($mode)) {
return "character device".($plural ? "s" : "");
} elsif (S_ISFIFO($mode)) {
return "fifo".($plural ? "s" : "");
} elsif (S_ISSOCK($mode)) {
return "socket".($plural ? "s" : "");
} else {
return "unknown filetype".($plural ? "s" : "");
}
}
# compare_files(oldfile, newfile)
# This is the actual diffing routine. It's quite long because we need to
# deal with all sorts of special cases. It will print to STDOUT a
# description of the differences between the two files. For regular files,
# diff(1) will be run to show the differences.
#
# return codes:
# 1 found a difference
# 2 had an error
# 3 found a difference and had an error
sub compare_files ($$) {
my ($oldname, $newname) = @_;
my ($old, $new); # stat buffers
my $return = 0;
# Get rid of unsightly double slashes
$oldname =~ s#//#/#g;
$newname =~ s#//#/#g;
eval { $old = lstat($oldname); };
if (not defined $old and not $!{ENOENT}) {
warn "$PROG: Could not stat $oldname: $!\n";
return 2;
}
eval { $new = lstat($newname); };
if (not defined $new and not $!{ENOENT}) {
warn "$PROG: Could not stat $newname: $!\n";
return 2;
}
# At this point, $old or $new should only be undefined if the
# file does not exist.
if (defined $old and defined $new) {
if (S_IFMT($old->mode) != S_IFMT($new->mode)) {
if ($opt{fakediff}) {
fakediff('filetype',
$oldname => filetype_to_string($old->mode),
$newname => filetype_to_string($new->mode),
);
} else {
print "File types differ between ".
filetype_to_string($old->mode)." $oldname and ".
filetype_to_string($new->mode)." $newname\n";
}
return 1;
}
if ($old->nlink != $new->nlink) {
# In recursive mode, we don't care about link counts in directories,
# as we'll pick that up with what files do and don't exist.
unless ($opt{recursive} and S_ISDIR($old->mode)) {
if ($opt{fakediff}) {
fakediff('nlink',
$oldname => $old->nlink,
$newname => $new->nlink,
);
} else {
print "Link counts differ between ".
filetype_to_string($old->mode, 1).
" $oldname and $newname\n";
}
$return = 1;
}
}
if ($old->uid != $new->uid and $opt{perms}) {
if ($opt{fakediff}) {
fakediff('uid',
$oldname => $old->uid,
$newname => $new->uid,
);
} else {
print "Owner differs between ".
filetype_to_string($old->mode, 1).
" $oldname and $newname\n";
}
$return = 1;
}
if ($old->gid != $new->gid and $opt{perms}) {
if ($opt{fakediff}) {
fakediff('gid',
$oldname => $old->gid,
$newname => $new->gid,
);
} else {
print "Group differs between ".
filetype_to_string($old->mode, 1).
" $oldname and $newname\n";
}
$return = 1;
}
if (S_IMODE($old->mode) != S_IMODE($new->mode) and $opt{perms}) {
if ($opt{fakediff}) {
fakediff('mode',
$oldname => sprintf('%04o', S_IMODE($old->mode)),
$newname => sprintf('%04o', S_IMODE($new->mode)),
);
} else {
print "Modes differ between ".
filetype_to_string($old->mode, 1).
" $oldname and $newname\n";
}
$return = 1;
}
# We don't want to compare anything more about sockets, fifos, or
# directories, once we've checked the permissions and link counts
if (S_ISSOCK($old->mode) or
S_ISFIFO($old->mode) or
S_ISDIR($old->mode)) {
return $return;
}
# Check device file devs, and that's it for them
if (S_ISCHR($old->mode) or
S_ISBLK($old->mode)) {
if ($old->rdev != $new->rdev) {
if ($opt{fakediff}) {
fakediff('rdev',
$oldname => $old->rdev,
$newname => $new->rdev,
);
} else {
print "Device numbers differ between ".
filetype_to_string($old->mode, 1).
" $oldname and $newname\n";
}
$return = 1;
}
return $return;
}
# Compare the targets of symlinks
if (S_ISLNK($old->mode)) {
my $oldtarget = readlink $oldname
or (warn("$PROG: Could not readlink($oldname): $!\n"),
return $return | 2);
my $newtarget = readlink $newname
or (warn("$PROG: Could not readlink($newname): $!\n"),
return $return | 2);
if ($oldtarget ne $newtarget) {
if ($opt{fakediff}) {
fakediff('target',
$oldname => $oldtarget,
$newname => $newtarget,
);
} else {
print "Symlink targets differ between $oldname and $newname\n";
}
$return = 1;
}
return $return;
}
if (not S_ISREG($old->mode)) {
warn "$PROG: Don't know what to do with file mode $old->mode!\n";
return 2;
}
} elsif (not defined $old and not defined $new) {
print "Neither $oldname nor $newname exists\n";
return $return;
} elsif (not defined $old) {
if (not S_ISREG($new->mode) or not $opt{'new-file'}) {
print "Only in ".dirname($newname).": ".
filetype_to_string($new->mode)." ".basename($newname)."\n";
return 1;
} elsif ($opt{'devnullhack'}) {
$oldname = '/dev/null';
}
} elsif (not defined $new) {
if (not S_ISREG($old->mode) or not $opt{'new-file'}) {
print "Only in ".dirname($oldname).": ".
filetype_to_string($old->mode)." ".basename($oldname)."\n";
return 1;
} elsif ($opt{'devnullhack'}) {
$newname = '/dev/null';
}
}
# They are regular files! We can actually run diff!
return diff($oldname, $newname) | $return;
}
sub diff ($$) {
my ($oldname, $newname) = @_;
my @command = (@diff, $oldname, $newname);
my $status;
# If we're not specifying unified diff, we need to print a header
# to indicate what's being diffed. (I'm not sure if this actually would
# work for patch, but it does tell our user what's going on).
# FIXME: We only need to specify this if the files are different
print "@command\n"
if not $opt{u};
{
# There is a bug in perl with use warnings FATAL => qw(all)
# that will cause the child process from system() to stick
# around if there is a warning generated.
# Shut off warnings -- we'll catch the error below.
no warnings;
$status = system(@command);
}
return 0 if ($status == 0);
if ($? == -1) {
die "$PROG: failed to execute '@command': $!\n";
}
if ($? & 128) {
die "$PROG: '@command' dumped core\n";
}
if (my $sig = $? & 127) {
die "$PROG: '@command' caught sig $sig\n"
unless ($sig == SIGPIPE);
}
if (my $exit = $? >> 8) {
if ($exit == 1) {
return 1;
} else {
die "$PROG: '@command' returned $exit\n";
}
}
return 0;
}
sub fakediff ($$) {
my ($type, $oldname, $oldvalue, $newname, $newvalue) = @_;
return unless $opt{fakediff};
my $time = strftime('%F %T.000000000 %z', localtime(0));
# We add a suffix onto the filenames to show we're not actually looking
# at file contents. There's no good way to indicate this that's compatible
# with patch, and this is simple enough.
$oldname .= '#~~' . $type;
$newname .= '#~~' . $type;
if ($opt{u}) {
# fake up a unified diff
print <<EOF;
--- $oldname\t$time
+++ $newname\t$time
@@ -1 +1 @@
-$oldvalue
+$newvalue
EOF
} else {
print <<EOF;
diff $oldname $newname
1c1
< $oldvalue
---
> $newvalue
EOF
}
}