frak

#!/usr/bin/perl
our $VERSION = '2.6 (2024-07-25)';
#
# frak -- Show changes between two AFS trees.
#
# Perhaps the single most useful AFS utility if you use replicated volumes
# regularly.  Compares two AFS trees to each other, generally the read/write
# and read-only versions of the same volume, and presents a readable summary
# of the differences so that you can see exactly what will be changed when the
# volume is released.
#
# "Don't be a _little_ paranoid; worry about everything, or let it all go."
#                                      -- James Alan Gardner, _Trapped_
#
# Written by Neil Crellin <neilc@stanford.edu>
# Updated by Russ Allbery <eagle@eyrie.org>
# Copyright 1998, 1999, 2004, 2011, 2013
#     The Board of Trustees of the Leland Stanford Junior University
#
# Updated by Bill MacAllister <bill@ca-zephyr.org>
# Copyright 2018
#    Bill MacAllister <bill@ca-zephyr.org>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Modules and declarations
##############################################################################

use 5.006;
use strict;
use warnings;

use vars qw($CHANGEDIR $CROSSMOUNT $DEBUG $LOGFILE $MUNGE $NODIFF $QUIET
  $ROOTRO $ROOTRW);

use Cwd          qw(cwd);
use File::Find   qw(find);
use File::stat   qw(lstat);
use Getopt::Long qw(GetOptions);
use POSIX        qw(strftime);
use Stat::lsMode qw(format_mode);

##############################################################################
# Site configuration
##############################################################################

# The default limit on the size of a diff in lines that will be included.
our $FRAK_MAXDIFF = 200;

# The full path to a suitable diff that supports -u.
our $DIFF = 'diff';

# The full path to fs and vos.  vos may be in an sbin directory, which may
# not be on the user's path by default, so check there first.
our $FS  = 'fs';
our $VOS = grep { -x $_ } qw(/usr/local/sbin/vos /usr/sbin/vos);
$VOS ||= 'vos';

# Load the configuration file if it exists.
if (-f '/etc/afs-admin-tools/config') {
    require '/etc/afs-admin-tools/config';
}

##############################################################################
# Utility functions
##############################################################################

# Quote an output string so that it will be safely and correctly parsed by
# bundle.  Passes through anything that looks like a variable reference to
# $ORIG or $DEST at the beginning of the string, however (be careful of this).
sub bundle_quote ( @ ) {
    my @strings = @_;
    for (@strings) {
        s/([\\\"\'\$\s])/\\$1/g;
        s/(\\\n)/\'$1\'/g;
        s/^\\\$(ORIG|DEST)/\$$1/;
    }
    return join(' ', @strings);
}

# Given the stat information for a file, return all of the various bundle
# variable settings to recreate that.
sub bundle_mode ( $ ) {
    my ($stat) = @_;
    my @vars = ('owner=' . $stat->uid, 'group=' . $stat->gid);
    push(@vars, sprintf('mode=%lo', $stat->mode & 07777));
    push(@vars, 'atime=' . $stat->atime, 'mtime=' . $stat->mtime);
    return @vars;
}

# Return a file name with the variable substitutions done for bundle.
sub bundle_name ( $$$ ) {
    my ($name, $base, $var) = @_;
    $name =~ s(^\Q$base\E) (\$$var);
    return $name;
}

# Return the fs command, as a list, to set the ACL on the given file to the
# given ACL string (in the compressed form that is returned by getacl).
sub bundle_setacl ( $$ ) {
    my ($name, $acl) = @_;
    my @acl = split(/=,/, $acl);
    unshift(@acl, $FS, 'setacl', $name);
    my $negative;
    @acl = map {
        if (!/^--/ || $negative) {
            $_;
        } else {
            ('-negative', $_);
        }
    } @acl;
    push(@acl, '-clear');
    return @acl;
}

##############################################################################
# Output functions
##############################################################################

# Print a header using equal signs.
sub header ( $ ) {
    my ($header) = @_;
    my $space    = length($header) + 4;
    my $lead     = (74 - $space) / 2;
    $header = '  ' . $header . '  ';
    my $out = '=' x $lead . $header . '=' x (74 - $lead - $space) . "\n";
    if (!$QUIET) {
        print $out;
    }
    if ($LOGFILE) {
        print LOG $out;
    }
}

# Add a file to the changed area.  Takes the name of the file and the prefix
# (new or old), and returns the file name in the changes area for use with
# later revert or apply directives.
sub changes ( $$ ) {
    my ($file, $type) = @_;
    if (!$CHANGEDIR) {
        return;
    }
    my $new = $file;
    $new =~ s(^\$(?:ORIG|DEST)) ($type)
      or die "$0: failed to build file name for $file\n";
    print CHANGES bundle_quote('file', $file, $new), "\n";
    return $new;
}

# Add something to the revert bundle if appropriate.
sub revert ( @ ) {
    my (@action) = @_;
    if (!$CHANGEDIR) {
        return;
    }
    print REVERT bundle_quote(@action), "\n";
}

# Add something to the apply bundle if appropriate.
sub apply ( @ ) {
    my (@action) = @_;
    if (!$CHANGEDIR) {
        return;
    }
    print APPLY bundle_quote(@action), "\n";
}

# Return the ls-style file listing for a particular file.  This doesn't do any
# particularly fancy formatting at the moment, although it certainly could.
# Takes the stat object for the file and a flag that, if set, suppresses the
# modification time display.
sub lslout ( $;$ ) {
    my ($stat, $nodate) = @_;
    if (!$stat) {
        return "---------- NO SUCH FILE????";
    }
    my $modestr     = format_mode($stat->mode);
    my $username    = getpwuid($stat->uid) || $stat->uid;
    my $groupname   = getgrgid($stat->gid) || $stat->gid;
    my $lastchanged = strftime('%Y-%m-%d %T', localtime $stat->mtime);
    my $output      = sprintf("%s %4d %-8s %-8s %8d",
        $modestr, $stat->nlink, $username, $groupname, $stat->size);
    if (!$nodate) {
        $output .= " $lastchanged";
    }
    return $output;
}

# Print the name of a file.  This will eventually do some programmatic munging
# of the file name on the way out the door.  Takes a prefix, the file name,
# and then a suffix if any.
sub print_name ( $$;$ ) {
    my ($prefix, $name, $suffix) = @_;
    if (defined $suffix) {
        $suffix = ' ' . $suffix;
    } else {
        $suffix = '';
    }
    if ($MUNGE) {
        $name =~ s/^$ROOTRW/.../;
    }
    if (!$QUIET) {
        print "$prefix: $name$suffix\n";
    }
    if ($LOGFILE) {
        print LOG "$prefix: $name$suffix\n";
    }
}

# Print the ls-style file listing for a file, the symlink value, or the mount
# point value.  Takes the prefix and the info hash, and an optional flag
# saying whether to display the directory listing even if this is a mount
# point.
sub print_ls ( $$;$ ) {
    my ($prefix, $info, $forcels) = @_;
    my $output;
    if ($$info{islink}) {
        $output = "-> $$info{link}";
    } elsif (defined $$info{volume} && !$forcels) {
        $output = "-> #$$info{volume}";
    } else {
        $output = lslout($$info{stat});
    }
    $output = '  ' . ($prefix ? $prefix . ': ' : '') . $output;
    if (!$QUIET) {
        print $output, "\n";
    }
    if ($LOGFILE) {
        print LOG $output, "\n";
    }
}

# Print an ACL list, taking a prefix.
sub print_acl ( $$ ) {
    my ($prefix, $acl) = @_;
    my $output = '  ACL ' . $prefix . ': ' . $acl . "\n";
    if (!$QUIET) {
        print $output;
    }
    if ($LOGFILE) {
        print LOG $output;
    }
}

# Run diff on two files if we're configured to do so and they're both text
# files.  Print the diff output if it's under the configured limit; otherwise
# print a message saying the output has been suppressed.
sub print_diff ( $$ ) {
    my ($old, $new) = @_;
    if ($NODIFF) {
        return '';
    }
    if (!(-T $old && -T $new)) {
        return '';
    }

    # Fork diff carefully.
    my $pid = open(DIFF, '-|');
    if (!defined $pid) {
        die "$0: cannot fork: $!\n";
    } elsif ($pid == 0) {
        open(STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
        exec($DIFF, '-u', $old, $new)
          or die "$0: cannot exec $DIFF -u $old $new: $!\n";
    }

    # Gather the output.
    local $_;
    my (@diff, $diff);
    while (<DIFF>) {
        if ($. <= 2) {
            s{(\s)(?:\Q$ROOTRO\E|\Q$ROOTRW\E)} {$1...};
        }
        if ($. <= $FRAK_MAXDIFF) {
            push(@diff, $_);
        }
    }
    my $output;
    if ($. > $FRAK_MAXDIFF) {
        $output = "    LARGE diff output suppressed, $. lines\n";
    } else {
        $output = join('', @diff);
    }
    close DIFF;
    if (!$QUIET) {
        print $output;
    }
    if ($LOGFILE) {
        print LOG $output;
    }
}

##############################################################################
# AFS information
##############################################################################

# Given a mount point, get the volume name of the volume mounted there or
# undef if it is not a mount point.
sub lsmount ( $ ) {
    my ($path) = @_;
    my $pid = open(LSMOUNT, '-|');
    if (!defined $pid) {
        die "$0: cannot fork: $!\n";
    } elsif ($pid == 0) {
        open(STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
        exec($FS, 'lsmount', $path)
          or die "$0: cannot exec $FS lsmount for $path: $!\n";
    }
    local $/;
    my $output = <LSMOUNT>;
    close LSMOUNT;
    if ($DEBUG) {
        print map { "===> $_ ($?)\n" } split(/\n/, $output);
    }
    if ($? != 0) {
        return;
    }
    my ($name)
      = ($output =~ /^\S+ is a mount point for volume \'[%\#](\S+)\'$/);
    return $name;
}

# Get the ACL for a directory, returning the ACL as a dense, comma-separated
# string.  Map full privileges to "all" and prefix negative rights with --
# (which may be theoretically ambiguous, but shouldn't be a problem in
# practice).  Returns NOT_IN_AFS if the path is apparently not in AFS.
sub getacl ( $ ) {
    my ($dir) = @_;

    # Fork off fs listacl carefully.
    my $pid = open(LISTACL, '-|');
    if (!defined $pid) {
        die "$0: cannot fork: $!\n";
    } elsif ($pid == 0) {
        open(STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
        exec($FS, 'listacl', $dir)
          or die "$0: cannot exec $FS listacl for $dir: $!\n";
    }

    # Read the results.  The first line is either a header or an error
    # message; if it's an error message, check to see if it says that the path
    # isn't in AFS and return NOT_IN_AFS in that situation.  Otherwise, look
    # for the "Normal rights:" and "Negative rights:" headers.  Assume that
    # all negative rights come after all normal rights.
    local $_;
    my $error = <LISTACL>;
    if ($error =~ /it is possible that .* is not in AFS/) {
        return 'NOT_IN_AFS';
    }
    my ($acl, $prefix) = ('', '');
    while (<LISTACL>) {
        if (/Normal rights:/) {
            next;
        }
        if (/Negative rights:/) {
            $prefix = '--';
            next;
        }
        my ($pts, $perms) = split;
        if ($perms eq 'rlidwka') {
            $perms = 'all';
        }
        $acl .= $prefix . $pts . '=' . $perms . ',';
    }
    close LISTACL;
    if ($? != 0) {
        warn $error;
        die "$0: $FS listacl failed for $dir with status ", ($? >> 8), "\n";
    }
    $acl =~ s/,$//;
    return $acl;
}

##############################################################################
# Analysis
##############################################################################

# Gather information about a file and return it as a hash.  The keys of the
# hash are set as follows:  stat gets a File::stat object for it, islink and
# isdir are booleans indicating whether the file is a link or a directory,
# link holds the value of the link if it is a link, volume holds the volume it
# is a mount point for if it is a mount point and undef otherwise, and acl
# holds the ACL for the directory if it is a directory.
sub examine ( $ ) {
    my ($file) = @_;
    my %info;
    $info{name} = $file;
    $info{stat} = lstat $file;
    if ($info{stat}) {
        $info{islink} = -l _;
        $info{isdir}  = -d _;
        if ($info{islink}) {
            $info{link} = readlink $file;
        }
        if ($info{isdir}) {
            $info{volume} = lsmount $file;
            my $isroot = ($file eq $ROOTRW || $file eq $ROOTRO);
            if (!defined $info{volume} || $CROSSMOUNT || $isroot) {
                $info{acl} = getacl $file;
            }
        }
    }
    return %info;
}

# Print out the appropriate information for something brand new that has
# appeared (no corresponding file in the read-only path).
sub compare_new ( $ ) {
    if ($DEBUG) {
        print "==> Comparing new file\n";
    }
    my %info = %{ $_[0] };
    if ($info{islink}) {
        print_name('New link', $info{name});
        revert('delete', $info{bname});
        apply('link', $info{link}, $info{bname});
    } elsif (defined $info{volume}) {
        print_name('New mountpoint', $info{name}, "-> #$info{volume}");
        revert('system', $FS, 'rmmount', $info{bname});
        apply('system', $FS, 'mkmount', $info{bname}, $info{volume});
    } elsif ($info{isdir}) {
        print_name('New directory', $info{name});
        revert('system', '/bin/rm', '-rf', $info{bname});
        apply('dir', $info{bname}, bundle_mode($info{stat}));
        apply('system', bundle_setacl($info{bname}, $info{acl}));
    } else {
        print_name('New', $info{name});
        my $saved = changes($info{bname}, 'new');
        revert('delete', $info{bname});
        apply('file', $saved, $info{bname});
    }
    if (!defined $info{volume}) {
        print_ls('', \%info);
    }
    if ($info{isdir} && $info{acl}) {
        print_acl('is', $info{acl});
    }
}

# Print out the appropriate information when the read/write volume has a link.
# Takes the information for both the read/write and read-only versions.
sub compare_link ( $$ ) {
    if ($DEBUG) {
        print "==> Comparing link\n";
    }
    my %rwinfo = %{ $_[0] };
    my %roinfo = %{ $_[1] };
    if ($roinfo{islink}) {
        if ($rwinfo{link} eq $roinfo{link}) {
            return;
        }
        print_name('Link change', $rwinfo{name});
        revert('link', $roinfo{link}, $rwinfo{bname});
        apply('link', $rwinfo{link}, $rwinfo{bname});
    } elsif (defined $roinfo{volume}) {
        print_name('Mountpoint replaced by link', $rwinfo{name});
        revert('delete', $rwinfo{bname});
        revert('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
        apply('system', $FS, 'rmmount', $rwinfo{bname});
        apply('link', $rwinfo{link}, $rwinfo{bname});
    } elsif ($roinfo{isdir}) {
        print_name('Directory replaced by link', $rwinfo{name});
        revert('delete', $rwinfo{bname});
        revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
        apply('system', '/bin/rm', '-rf', $rwinfo{bname});
        apply('link', $rwinfo{link}, $rwinfo{bname});
    } else {
        print_name('Non-link replaced by link', $rwinfo{name});
        my $saved = changes($roinfo{bname}, 'old');
        revert('file', $saved, $rwinfo{bname});
        apply('link', $rwinfo{link}, $rwinfo{bname});
    }
    print_ls('WAS', \%roinfo);
    print_ls('NOW', \%rwinfo);
}

# Print out the appropriate information when the read/write volume has a mount
# point.  Takes the information for both the read/write and read-only
# versions.
sub compare_mount ( $$ ) {
    if ($DEBUG) {
        print "==> Comparing mountpoint\n";
    }
    my %rwinfo = %{ $_[0] };
    my %roinfo = %{ $_[1] };
    if ($roinfo{islink}) {
        print_name('Link replaced by mountpoint', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        revert('system', $FS, 'rmmount', $rwinfo{bname});
        revert('link', $roinfo{link}, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
        apply('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
    } elsif (defined $roinfo{volume}) {
        if ($rwinfo{volume} ne $roinfo{volume} && $rwinfo{name} ne $ROOTRW) {
            print_name('Mountpoint change', $rwinfo{name});
            print_ls('WAS', \%roinfo);
            print_ls('NOW', \%rwinfo);
            revert('system', $FS, 'rmmount', $rwinfo{bname});
            revert('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
            apply('system', $FS, 'rmmount', $rwinfo{bname});
            apply('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
        } elsif ($rwinfo{name} eq $ROOTRW || $CROSSMOUNT) {
            if (!$rwinfo{stat}) {
                return;
            }
            my $old = lslout($roinfo{stat}, 1);
            my $new = lslout($rwinfo{stat}, 1);
            if ($new ne $old) {
                print_name('Changed directory', $rwinfo{name});
                print_ls('WAS', \%roinfo, 1);
                print_ls('NOW', \%rwinfo, 1);
                revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
                apply('dir', $rwinfo{bname}, bundle_mode($rwinfo{stat}));
            }
            if ($rwinfo{acl} eq $roinfo{acl}) {
                return;
            }
            print_name('ACL changed', $rwinfo{name});
            print_acl('WAS', $roinfo{acl});
            print_acl('NOW', $rwinfo{acl});
            revert('system', bundle_setacl($rwinfo{bname}, $roinfo{acl}));
            apply('system', bundle_setacl($rwinfo{bname}, $rwinfo{acl}));
        }
    } elsif ($roinfo{isdir}) {
        print_name('Directory replacd by mountpoint', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        revert('system', $FS, 'rmmount', $rwinfo{bname});
        revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
        apply('system', '/bin/rm', '-rf', $rwinfo{bname});
        apply('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
    } else {
        print_name('File replaced by mountpoint', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        my $saved = changes($roinfo{bname}, 'old');
        revert('system', $FS, 'rmmount', $rwinfo{bname});
        revert('file', $saved, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
        apply('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
    }
}

# Print out the appropriate information when the read/write volume has a
# directory.  Takes the information for both the read/write and read-only
# versions.
sub compare_dir ( $$ ) {
    if ($DEBUG) {
        print "==> Comparing directory\n";
    }
    my %rwinfo = %{ $_[0] };
    my %roinfo = %{ $_[1] };
    if ($roinfo{islink}) {
        print_name('Link replaced by directory', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        revert('system', '/bin/rm', '-rf', $rwinfo{bname});
        revert('link', $roinfo{link}, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
        apply('dir', $rwinfo{bname}, bundle_mode($rwinfo{stat}));
    } elsif (defined $roinfo{volume}) {
        print_name('Mountpoint replaced by directory', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        revert('system', '/bin/rm', '-rf', $rwinfo{bname});
        revert('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
        apply('system', $FS, 'rmmount', $rwinfo{bname});
        apply('dir', $rwinfo{bname}, bundle_mode($rwinfo{stat}));
    } elsif ($roinfo{isdir}) {
        my $old = lslout($roinfo{stat}, 1);
        my $new = lslout($rwinfo{stat}, 1);
        if ($new ne $old) {
            print_name('Changed directory', $rwinfo{name});
            print_ls('WAS', \%roinfo);
            print_ls('NOW', \%rwinfo);
            revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
            apply('dir', $rwinfo{bname}, bundle_mode($rwinfo{stat}));
        }
        if ($rwinfo{acl} ne $roinfo{acl}) {
            print_name('ACL changed', $rwinfo{name});
            print_acl('WAS', $roinfo{acl});
            print_acl('NOW', $rwinfo{acl});
            revert('system', bundle_setacl($rwinfo{bname}, $roinfo{acl}));
            apply('system', bundle_setacl($rwinfo{bname}, $rwinfo{acl}));
        }
    } else {
        print_name('File replaced by directory', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        my $saved = changes($roinfo{bname}, 'old');
        revert('system', '/bin/rm', '-rf', $rwinfo{bname});
        revert('file', $saved, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
        apply('dir', $rwinfo{bname}, bundle_mode($rwinfo{stat}));
    }
}

# Print out the appropriate information when the read/write volume has a
# regular file.  Takes the information for both the read/write and read-only
# versions.
sub compare_file ( $$ ) {
    if ($DEBUG) {
        print "==> Comparing file\n";
    }
    my %rwinfo = %{ $_[0] };
    my %roinfo = %{ $_[1] };
    if ($roinfo{islink}) {
        print_name('Link replaced by non-link', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        my $saved = changes($rwinfo{bname}, 'new');
        revert('link', $roinfo{link}, $rwinfo{bname});
        apply('file', $saved, $rwinfo{bname});
    } elsif (defined $roinfo{volume}) {
        print_name('Mountpoint replaced by file', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        my $saved = changes($rwinfo{bname}, 'new');
        revert('delete', $rwinfo{bname});
        revert('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
        apply('system', $FS, 'rmmount', $rwinfo{bname});
        apply('file', $saved, $rwinfo{bname});
    } elsif ($roinfo{isdir}) {
        print_name('Directory replaced by file', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        my $saved = changes($rwinfo{bname}, 'new');
        revert('delete', $rwinfo{bname});
        revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
        apply('system', '/bin/rm', '-rf', $rwinfo{bname});
        apply('file', $saved, $rwinfo{bname});
    } else {
        my $newls = lslout($rwinfo{stat});
        my $oldls = lslout($roinfo{stat});
        if (!($newls ne $oldls)) {
            return;
        }
        print_name('Changed', $rwinfo{name});
        print_ls('WAS', \%roinfo);
        print_ls('NOW', \%rwinfo);
        print_diff($roinfo{name}, $rwinfo{name});
        my $old = changes($roinfo{bname}, 'old');
        my $new = changes($rwinfo{bname}, 'new');
        revert('file', $old, $rwinfo{bname});
        apply('file', $new, $rwinfo{bname});
    }
}

# Compare in the forward direction (read/write to read-only).  This will pick
# up file creations and changes, but will not pick up file deletions.  This
# function is called for each file found in the read/write volume.
sub analyze_forward {
    if ($DEBUG) {
        print "=> Inspecting $File::Find::name\n";
    }
    my $rw = $File::Find::name;
    my $ro = $rw;
    $ro =~ s(^\Q$ROOTRW\E)($ROOTRO);
    my %rwinfo = examine($rw);
    my %roinfo = examine($ro);
    $rwinfo{bname} = bundle_name($rwinfo{name}, $ROOTRW, 'DEST');
    $roinfo{bname} = bundle_name($roinfo{name}, $ROOTRO, 'ORIG');

    # If the stat failed, that probably means that we have a mount point to a
    # volume that doesn't exist.  Handle that case specially.
    if (!$rwinfo{stat}) {
        $rwinfo{volume} = lsmount $rw;
        if (!defined $rwinfo{volume}) {
            return;
        }
    }

    # If this was a mount point, prune here.
    $File::Find::prune = 1
      if ($rw ne $ROOTRW && $rwinfo{volume} && !$CROSSMOUNT);
    $File::Find::prune = 1
      if ($ro ne $ROOTRO && $roinfo{volume} && !$CROSSMOUNT);

    # Do the analysis, or rather call all the individual functions that do the
    # analysis.
    if    (!$roinfo{stat})          { compare_new(\%rwinfo) }
    elsif ($rwinfo{islink})         { compare_link(\%rwinfo, \%roinfo) }
    elsif (defined $rwinfo{volume}) { compare_mount(\%rwinfo, \%roinfo) }
    elsif ($rwinfo{isdir})          { compare_dir(\%rwinfo, \%roinfo) }
    else                            { compare_file(\%rwinfo, \%roinfo) }
}

# Compare in the reverse direction (read-only to read/write).  The only thing
# we pick up here are deletions, so we ignore any case where the object exists
# in the read/write volume (since we would have reported on it during the
# forward pass).  This function is called for each file found in the read-only
# volume.
sub analyze_reverse {
    if ($DEBUG) {
        print "=> Inspecting $File::Find::name\n";
    }
    my $ro = $File::Find::name;
    my $rw = $ro;
    $rw =~ s(^\Q$ROOTRO\E)($ROOTRW);
    my %rwinfo = examine($rw);

    # If this was a mount point, prune here.  Note that we prune based on the
    # read/write path because we want to be able to avoid the stat of the
    # read-only side if the read/write side exists.  Because of the forward
    # pass, this won't cause us to miss anything significant.
    if ($rw ne $ROOTRW && $rwinfo{volume} && !$CROSSMOUNT) {
        $File::Find::prune = 1;
    }
    if ($rwinfo{stat}) {
        return;
    }

    # Now check the read-only side.  We also prune if the read-only side is a
    # mount point, of course.
    my %roinfo = examine($ro);
    $File::Find::prune = 1
      if ($ro ne $ROOTRO && $roinfo{volume} && !$CROSSMOUNT);
    $rwinfo{bname} = bundle_name($rwinfo{name}, $ROOTRW, 'DEST');
    $roinfo{bname} = bundle_name($roinfo{name}, $ROOTRO, 'ORIG');

    # If stat failed, that probably means that we have a mount point to a
    # volume that no longer exists.  Handle that case as a special situation.
    if (!$roinfo{stat}) {
        $roinfo{volume} = lsmount $ro;
        if (!defined $roinfo{volume}) {
            return;
        }
    }

    # Analyze the difference and report appropriately.
    if ($roinfo{islink}) {
        print_name('Deleted link', $rwinfo{name});
        print_ls('', \%roinfo);
        revert('link', $roinfo{link}, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
    } elsif (defined $roinfo{volume}) {
        print_name('Deleted mountpoint', $rwinfo{name}, "-> #$roinfo{volume}");
        revert('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
        apply('system', $FS, 'rmmount', $rwinfo{bname});
    } elsif ($roinfo{isdir}) {
        print_name('Deleted directory', $rwinfo{name});
        revert('dir', $rwinfo{bname}, bundle_mode($roinfo{stat}));
        apply('system', '/bin/rm', '-rf', $rwinfo{bname});
    } else {
        print_name('Deleted', $rwinfo{name});
        my $saved = changes($roinfo{bname}, 'old');
        revert('file', $saved, $rwinfo{bname});
        apply('delete', $rwinfo{bname});
    }
}

##############################################################################
# Main routine
##############################################################################

# Trim extraneous garbage from the path.
my $fullpath = $0;
$0 =~ s%.*/%%;

# Make sure we get output in the right order.
$| = 1;

# Parse our options.
my ($help, $logfile, $nolog, $version);
Getopt::Long::config('bundling');
GetOptions(
    'cross-mounts|C'     => \$CROSSMOUNT,
    'change-dir|c=s'     => \$CHANGEDIR,
    'debug|D'            => \$DEBUG,
    'max-diff-lines|d=i' => \$FRAK_MAXDIFF,
    'help|h'             => \$help,
    'no-log|L'           => \$nolog,
    'log-file|l=s'       => \$logfile,
    'munge|m'            => \$MUNGE,
    'quiet|q'            => \$QUIET,
    'suppress-diff|s'    => \$NODIFF,
    'version|v'          => \$version
) or exit 1;
if ($help) {
    exec('perldoc', '-t', $fullpath);
    exit 1;
} elsif ($version) {
    print "frak $VERSION\n";
    exit 1;
}
if ($logfile) {
    $LOGFILE = $logfile;
}

# Check the directories we're given.  If the -m option is used, we should
# instead have a single argument naming the volume and will be mounting it in
# the current directory.
if (@ARGV > 2 || @ARGV < 1) {
    die "Usage: $0 [-CDhLmqsv] [-c <change>] [-d <n>] [-l <log>] "
      . "<rw> [<ro>]\n";
}
my ($rw, $ro, $volume, $mounted);
if (@ARGV == 1 && $ARGV[0] !~ m%/%) {
    $MUNGE  = 1;
    $volume = $ARGV[0];
    $volume =~ s/\.readonly$//;
    my $rovolume = $volume . '.readonly';
    $rw = "frak-$volume";
    $ro = "frak-$rovolume";
    system($FS, 'mkmount', $ro, $rovolume) == 0
      or die "$0: failed to create mount for $rovolume\n";
    system($FS, 'mkmount', '-rw', $rw, $volume) == 0
      or die "$0: failed to create mount for $volume\n";
    $mounted = 1;

    if (!($nolog || $logfile)) {
        $LOGFILE = $volume;
    }
} else {
    ($rw, $ro) = @ARGV;
    if (@ARGV == 1 && $rw =~ m%/afs/[^.]%) {
        warn "$0: only argument specifies a read-only path, correcting\n";
        $rw =~ s%/afs/%/afs/.%;
    }
    if (!$ro) {
        $ro = $rw;
        $ro =~ s%/afs/\.%/afs/%;
        if ($rw eq $ro) {
            die "$0: cannot intuit read-only path from read/write path\n";
        }
    }
    $volume = lsmount($rw);
    if (!defined $volume) {
        warn "$0: $rw is not a mountpoint for its volume\n";
    }
}

# Get rid of any trailing slashes.
s%/+$%% for ($rw, $ro);

# Check the validity of the read/write directory.
if (!-d $rw) {
    die "$0: read/write path $rw not found or not a directory\n";
}

# Set the global variables.
($ROOTRW, $ROOTRO) = ($rw, $ro);

# If a changedir is requested, set up the file handles and files.
if ($CHANGEDIR) {
    open(CHANGES, "> $CHANGEDIR/changes.b")
      or die "$0: cannot create $CHANGEDIR/changes.b: $!\n";
    open(REVERT, "> $CHANGEDIR/revert.b")
      or die "$0: cannot create $CHANGEDIR/revert.b: $!\n";
    open(APPLY, "> $CHANGEDIR/apply.b")
      or die "$0: cannot create $CHANGEDIR/apply.b: $!\n";
    mkdir("$CHANGEDIR/old", 0755)
      or die "$0: cannot create $CHANGEDIR/old: $!\n";
    mkdir("$CHANGEDIR/new", 0755)
      or die "$0: cannot create $CHANGEDIR/new: $!\n";
    print CHANGES "ORIG=", bundle_quote($ROOTRO), "\n";
    print CHANGES "DEST=", bundle_quote($ROOTRW), "\n";
    print REVERT "ORIG=",  bundle_quote($ROOTRO), "\n";
    print REVERT "DEST=",  bundle_quote($ROOTRW), "\n";
    print APPLY "ORIG=",   bundle_quote($ROOTRO), "\n";
    print APPLY "DEST=",   bundle_quote($ROOTRW), "\n";
}

# If a log is requested, create the log file.
if ($LOGFILE) {
    open(LOG, "> $LOGFILE")
      or die "$0: cannot create log file $LOGFILE: $!\n";
}

# Print the header if we have a volume.
if (defined $volume) {
    header($volume);
}

# Do the actual work.
$File::Find::dont_use_nlink = 1;
find({ wanted => \&analyze_forward, no_chdir => 1 }, $ROOTRW);
if (!$QUIET) {
    print "\n";
}
if ($LOGFILE) {
    print LOG "\n";
}
find({ wanted => \&analyze_reverse, no_chdir => 1 }, $ROOTRO);
if (!$QUIET) {
    print "\n";
}
if ($LOGFILE) {
    print LOG "\n";
}

# Remove the mount points if we created them.  Try to do this even if we
# exited on error.
END {
    if ($mounted) {
        system($FS, 'rmmount', "frak-$volume.readonly") == 0
          or warn "$0: cannot remove ro mount point for volume\n";
        system($FS, 'rmmount', "frak-$volume") == 0
          or warn "$0: cannot remove rw mount point for volume\n";
    }
}

__END__

############################################################################
# Documentation
############################################################################

=for stopwords
non-AFS AFS -CDhLmqsv Crellin afs-admin-tools changedir frak fs --munge
ro-path rw-path vos Battlestar Galactica --change-dir

=head1 NAME

frak - Show changes between two AFS trees

=head1 SYNOPSIS

frak [B<-CDhLmqsv>] [B<-c> I<changedir>] [B<-d> I<max-diff-lines>] [B<-l>
I<logfile>] (I<volume> | I<rw-path> [ I<ro-path> ])

=head1 DESCRIPTION

B<frak> is a tool for comparing the structure and contents of two
directory trees in AFS.  Its most common use is to determine the changes
in a read/write AFS volume relative to the read-only copy of the same
volume, to ensure that it's safe to release, but it can be used to compare
any two arbitrary AFS trees.  It can even be used in a limited fashion to
compare non-AFS trees, although in that case C<diff -r> may be more
appropriate.

B<frak> understands mount points and directory ACLs and will detect
changes in those as well as more typical changes in file size,
permissions, or existence.  It also knows not to cross mount points
(unless given the B<-C> option).  Note that two files with the same
permissions and the same size will be considered identical; the file is
not actually compared with diff if its other information matches.

If two files are different and are determined to be text files (using the
C<-T> probe in Perl; see L<perlfunc> for more information), C<diff -u>
will be run on the two files.  This output will be included in the B<frak>
output provided it's less than 100 lines long (controllable with B<-d>).
Otherwise, just the length of the diff in lines will be given.  Diffs can
be suppressed completely with B<-s>.

The paths to compare may be specified in three ways.  A volume name can be
given as the sole argument (distinguished from a path by the fact that it
doesn't contain a C</>).  In this case, the read-only and read-write
versions of that volume will be mounted in the current working directory
(so the current working directory must be in AFS), as F<frak-I<volume>>
and F<frak-I<volume>.readonly>, and then compared.  A path may be given as
the sole argument, in which case it is taken to be the path to the
read-write version of the tree and should begin with C</afs/.>.  It will
be compared against the read-only path to the same tree, formed by
removing the period after C</afs/>.  Or, finally, two paths may be given,
and they will be taken to be the read-write path (the newer tree) and the
read-only path (the older tree) respectively.  Please note that this is
the exact opposite order from what one would pass to B<diff>.

If a volume is specified, B<frak> will by default log the output to a file
named after the volume in the current directory, as well as printing the
output to standard output.  To suppress the file log, use B<-L>.  To
suppress the output to standard out, use B<-q>.  The name and location of
the log file can be changed with B<-l>.  If a path is specified, B<frak>
will by default only print to standard output.  To also log to a file,
specify a log file location with B<-l>.  In either case, the log file will
be overwritten if it already exists.

If a volume is specified, paths in the output will be shown relative to
the root of the volume.  If a path is specified, paths in the output will
be complete paths unless B<-m> is given.  If B<-m> is given, paths will be
relative to the root of the tree specified by the path given on the
command line.

The name B<frak> comes from the swear word used in I<Battlestar
Galactica>, which should give you some ideas about the origin of this
program.

=head1 OPTIONS

=over 4

=item B<-C>, B<--cross-mounts>

Normally, B<frak> will never cross a mount point.  If this option is
given, it will keep comparing through mount points.  Be careful when using
this option, since B<frak> will happily recurse through all AFS file
systems in the world, and remember that circular path structures are
possible in AFS.  B<frak> does no checking to make sure that it doesn't
revisit the same volume endlessly.

=item B<-c> I<changedir>, B<--change-dir>=I<changedir>

When given this option, B<frak> creates three bundles I<changedir>, as
well as directories named F<new> and F<old>.  The first bundle is named
F<changes.b>, which if run will populate the F<new> and F<old> directories
with all of the files that have changed between the two trees.  The second
bundle, F<revert.b>, will use those files to revert the changes to the
read-write path so that it matches the read-only path.  The third bundle,
F<apply.b>, will reapply the changes to the read-write path so that it
returns to the state that it was in before B<frak> was run.

The intended use of this feature is to make it possible to back out
arbitrary changes made to the read-write path of a volume, release the
volume, and then put those changes back.  Please note that this feature is
not as well-tested as the rest of B<frak>, and the bundles should be
reviewed very carefully before use.  Note also that B<frak> can be used
again after F<revert.b> has been applied, to make sure that the read-write
volume really does match the read-only volume.

This option only really makes sense when used with a path, rather than a
volume, on the command line.  Otherwise, the bundles will use paths
relative to the temporary mount points created by B<frak>, which isn't as
useful.

=item B<-D>, B<--debug>

Display additional debugging information.  This is mostly only useful for
debugging B<frak>.

=item B<-d> I<max-diff-lines>, B<--max-diff-lines>=I<max-diff-lines>

Limit the number of lines of diffs shown for changed files to
I<max-diff-lines>.  The default is the value of the $FRAK_MAXDIFF
configuration variable, which in turn defaults to 200.  Diffs with longer
than that number of lines will be replaced with a message saying how many
total lines the diff had.

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script
to C<perldoc -t>).

=item B<-L>, B<--no-log>

Suppress the default logging to a file that occurs if a volume rather than
a path is specified on the command line.  The output will only be sent to
standard output.

=item B<-l> I<log>, B<--log-file>=I<log>

Log the B<frak> output to I<log> as well as to standard output.  If a
volume was specified on the command line, this overrides the default log
file name (the name of the volume).  If a path was specified, this enables
logging to a file.

=item B<-m>, B<--munge>

Only meaningful when a path was specified on the command line.  Tells
B<frak> to show paths in the output relative to the top of the tree
specified on the command line, rather than showing absolute paths.

=item B<-q>, B<--quiet>

Suppress the normal output to standard output.  B<frak> output will only
be sent to the log file, if any.

=item B<-s>, B<--suppress-diffs>

Suppress diffs for changed files.  This also turns off the check to see if
changed files are binary or text, and will make B<frak> run somewhat
faster.

=item B<-v>, B<--version>

Print out the version of B<frak> and exit.

=back

=head1 CONFIGURATION

B<frak> loads configuration settings from F</etc/afs-admin-tools/config>
if that file exists.  If it exists, it must be Perl code suitable for
loading with C<require>.  This means that each line of the configuration
file should be of the form:

    our $VARIABLE = VALUE;

where C<$VARIABLE> is the configuration variable being set and C<VALUE> is
the value to set it to (which should be enclosed in quotes if it's not a
number).  The file should end with:

    1;

so that Perl knows the file was loaded correctly.

The supported configuration variables are:

=over 4

=item $FRAK_MAXDIFF

The default limit on the number of diff lines that will be included.  This
should be a number.  The default value is 200.  This setting is overridden
by the B<-d> command-line option.

=item $DIFF

The full path to a B<diff> implementation that supports the B<-u> option.
If this variable is not set, B<frak> defaults to using the first B<diff>
program found on the user's path.

=item $FS

The full path to the AFS B<fs> utility.  If this variable is not set,
B<frak> defaults to looking for B<fs> on the user's PATH.

=item $VOS

The full path to the AFS B<vos> utility.  If this variable is not set,
B<frak> defaults to F</usr/local/sbin/vos> or F</usr/sbin/vos> if they
exist, and otherwise looks for B<vos> on the user's PATH.

=back

=head1 EXAMPLES

Compare the read-write and read-only copies of the volume C<pubsw>,
mounting both in the current directory to do the comparison, and putting a
copy of the output into the file F<pubsw> in the current directory:

    frak pubsw

Do the same, but store the output in F</tmp/pubsw.log>:

    frak -l /tmp/pubsw.log pubsw

The same, but don't print anything other than errors to standard output:

    frak -q -l /tmp/pubsw.log pubsw

The same, but only print the output to standard output:

    frak -L pubsw

Compare the path F</afs/.ir.stanford.edu/pubsw> to
F</afs/ir.stanford.edu/pubsw>, printing the output to standard output.

    frak /afs/.ir.stanford.edu/pubsw

A completely equivalent way to do the same thing:

    frak /afs/.ir.stanford.edu/pubsw /afs/ir.stanford.edu/pubsw

Do the same, but log the output to F</tmp/pubsw.log>:

    frak -l /tmp/pubsw.log /afs/.ir.stanford.edu/pubsw

Compare the read-write and read-only copies of the volume C<pubsw>,
writing the change bundles into the subdirectory F<changes> of the current
directory:

    frak -c changes /afs/.ir.stanford.edu/pubsw

One can then cd to the F<changes> directory and run C<changes.b>, and then
C<revert.b> to revert the changes to the read-write path.  At some point
later, one could run C<apply.b> to replace the changes.

=head1 AUTHOR

Originally written by Neil Crellin <neilc@stanford.edu>.  Substantially
reorganized and rewritten by Russ Allbery <eagle@eyrie.org>. Updated
with Auristor support by Bill MacAllister <bill@ca-zephyr.org>.

=head1 COPYRIGHT AND LICENSE

Copyright 1998, 1999, 2004, 2011 The Board of Trustees of the Leland
Stanford Junior University.

Copyright 2018 Bill MacAllister <bill@ca-zephyr.org>

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<bundle(1)>, L<diff(1)>

This script is part of the afs-admin-tools package.  The most recent
version is available from the afs-admin-tools web page at
L<http://www.eyrie.org/~eagle/software/afs-admin-tools/>.

B<bundle>, for the B<--change-dir> feature, is available from
L<http://www.eyrie.org/~eagle/software/bundle/>.

=cut