515 lines
14 KiB
Plaintext
515 lines
14 KiB
Plaintext
|
#!/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
|
||
|
}
|
||
|
}
|