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