bin/frak

   1 #!/usr/bin/perl -w
   2 #
   3 # frak -- Show changes between two AFS trees.
   4 #
   5 # Written by Neil Crellin <neilc@stanford.edu>
   6 # Updated by Russ Allbery <rra@stanford.edu>
   7 # Copyright 1998, 1999, 2004 Board of Trustees, Leland Stanford Jr. University
   8 #
   9 # This program is free software; you may redistribute it and/or modify it
  10 # under the same terms as Perl itself.
  11 #
  12 # Perhaps the single most useful AFS utility if you use replicated volumes
  13 # regularly.  Compares two AFS trees to each other, generally the read/write
  14 # and read-only versions of the same volume, and presents a readable summary
  15 # of the differences so that you can see exactly what will be changed when the
  16 # volume is released.
  17
  18 ##############################################################################
  19 # Site configuration
  20 ##############################################################################
  21
  22 # The full path to a suitable diff that supports -u.
  23 $DIFF = '/usr/pubsw/bin/diff';
  24
  25 # The default limit on the size of a diff in lines that will be included.
  26 $MAXDIFF = 200;
  27
  28 # The full path to fs and vos.  Allow for Linux where the preferred location
  29 # may be on local disk.
  30 ($FS)  = grep { -x $_ } qw(/usr/bin/fs /usr/afsws/bin/fs /usr/pubsw/bin/fs);
  31 $FS ||= '/usr/afsws/bin/fs';
  32 ($VOS) = grep { -x $_ } qw(/usr/bin/vos /usr/pubsw/bin/vos);
  33 $VOS ||= '/usr/pubsw/bin/vos';
  34
  35 ##############################################################################
  36 # Modules and declarations
  37 ##############################################################################
  38
  39 require 5.005;
  40
  41 use strict;
  42 use vars qw($CHANGEDIR $CROSSMOUNT $DEBUG $DIFF $FS $ID $LOGFILE $MAXDIFF
  43             $MUNGE $NODIFF $QUIET $ROOTRO $ROOTRW $VOS);
  44
  45 use Cwd qw(cwd);
  46 use File::Find qw(find);
  47 use File::stat qw(lstat);
  48 use Getopt::Long qw(GetOptions);
  49 use POSIX qw(strftime);
  50 use Stat::lsMode qw(format_mode);
  51
  52 ##############################################################################
  53 # Utility functions
  54 ##############################################################################
  55
  56 # Quote an output string so that it will be safely and correctly parsed by
  57 # bundle.  Passes through anything that looks like a variable reference to
  58 # $ORIG or $DEST at the beginning of the string, however (be careful of this).
  59 sub bundle_quote ( @ ) {
  60     my @strings = @_;
  61     for (@strings) {
  62         s/([\\\"\'\$\s])/\\$1/g;
  63         s/(\\\n)/\'$1\'/g;
  64         s/^\\\$(ORIG|DEST)/\$$1/;
  65     }
  66     return join (' ', @strings);
  67 }
  68
  69 # Given the stat information for a file, return all of the various bundle
  70 # variable settings to recreate that.
  71 sub bundle_mode ( $ ) {
  72     my ($stat) = @_;
  73     my @vars = ('owner=' . $stat->uid, 'group=' . $stat->gid);
  74     push (@vars, sprintf ('mode=%lo', $stat->mode & 07777));
  75     push (@vars, 'atime=' . $stat->atime, 'mtime=' . $stat->mtime);
  76     return @vars;
  77 }
  78
  79 # Return a file name with the variable substitutions done for bundle.
  80 sub bundle_name ( $$$ ) {
  81     my ($name, $base, $var) = @_;
  82     $name =~ s(^\Q$base\E) (\$$var);
  83     return $name;
  84 }
  85
  86 # Return the fs command, as a list, to set the ACL on the given file to the
  87 # given ACL string (in the compressed form that is returned by getacl).
  88 sub bundle_setacl ( $$ ) {
  89     my ($name, $acl) = @_;
  90     my @acl = split (/=,/, $acl);
  91     unshift (@acl, $FS, 'setacl', $name);
  92     my $negative;
  93     @acl = map {
  94         if (!/^--/ || $negative) {
  95             $_;
  96         } else {
  97             ('-negative', $_);
  98         }
  99     } @acl;
 100     push (@acl, '-clear');
 101     return @acl;
 102 }
 103
 104 ##############################################################################
 105 # Output functions
 106 ##############################################################################
 107
 108 # Print a header using equal signs.
 109 sub header ( $ ) {
 110     my ($header) = @_;
 111     my $space = length ($header) + 4;
 112     my $lead = (74 - $space) / 2;
 113     $header = '  ' . $header . '  ';
 114     my $out = '=' x $lead . $header . '=' x (74 - $lead - $space) . "\n";
 115     print $out unless $QUIET;
 116     print LOG $out if $LOGFILE;
 117 }
 118
 119 # Add a file to the changed area.  Takes the name of the file and the prefix
 120 # (new or old), and returns the file name in the changes area for use with
 121 # later revert or apply directives.
 122 sub changes ( $$ ) {
 123     my ($file, $type) = @_;
 124     return unless $CHANGEDIR;
 125     my $new = $file;
 126     $new =~ s(^\$(?:ORIG|DEST)) ($type)
 127         or die "$0: failed to build file name for $file\n";
 128     print CHANGES bundle_quote ('file', $file, $new), "\n";
 129     return $new;
 130 }
 131
 132 # Add something to the revert bundle if appropriate.
 133 sub revert ( @ ) {
 134     my (@action) = @_;
 135     return unless $CHANGEDIR;
 136     print REVERT bundle_quote (@action), "\n";
 137 }
 138
 139 # Add something to the apply bundle if appropriate.
 140 sub apply ( @ ) {
 141     my (@action) = @_;
 142     return unless $CHANGEDIR;
 143     print APPLY bundle_quote (@action), "\n";
 144 }
 145
 146 # Return the ls-style file listing for a particular file.  This doesn't do any
 147 # particularly fancy formatting at the moment, although it certainly could.
 148 # Takes the stat object for the file and a flag that, if set, suppresses the
 149 # modification time display.
 150 sub lslout ( $;$ ) {
 151     my ($stat, $nodate) = @_;
 152     return "---------- NO SUCH FILE????" unless $stat;
 153     my $modestr = format_mode ($stat->mode);
 154     my $username = getpwuid ($stat->uid) || $stat->uid;
 155     my $groupname = getgrgid ($stat->gid) || $stat->gid;
 156     my $lastchanged = strftime ('%Y-%m-%d %T', localtime $stat->mtime);
 157     my $output = sprintf ("%s %4d %-8s %-8s %8d", $modestr, $stat->nlink,
 158                           $username, $groupname, $stat->size);
 159     $output .= " $lastchanged" unless $nodate;
 160     return $output;
 161 }
 162
 163 # Print the name of a file.  This will eventually do some programmatic munging
 164 # of the file name on the way out the door.  Takes a prefix, the file name,
 165 # and then a suffix if any.
 166 sub print_name ( $$;$ ) {
 167     my ($prefix, $name, $suffix) = @_;
 168     if (defined $suffix) {
 169         $suffix = ' ' . $suffix;
 170     } else {
 171         $suffix = '';
 172     }
 173     $name =~ s/^$ROOTRW\E/.../ if $MUNGE;
 174     print "$prefix: $name$suffix\n" unless $QUIET;
 175     print LOG "$prefix: $name$suffix\n" if $LOGFILE;
 176 }
 177
 178 # Print the ls-style file listing for a file, the symlink value, or the mount
 179 # point value.  Takes the prefix and the info hash, and an optional flag
 180 # saying whether to display the directory listing even if this is a mount
 181 # point.
 182 sub print_ls ( $$;$ ) {
 183     my ($prefix, $info, $forcels) = @_;
 184     my $output;
 185     if ($$info{islink}) {
 186         $output = "-> $$info{link}";
 187     } elsif (defined $$info{volume} && !$forcels) {
 188         $output = "-> #$$info{volume}";
 189     } else {
 190         $output = lslout ($$info{stat});
 191     }
 192     $output = '  ' . ($prefix ? $prefix . ': ' : '') . $output;
 193     print $output, "\n" unless $QUIET;
 194     print LOG $output, "\n" if $LOGFILE;
 195 }
 196
 197 # Print an ACL list, taking a prefix.
 198 sub print_acl ( $$ ) {
 199     my ($prefix, $acl) = @_;
 200     my $output = '  ACL ' . $prefix . ': ' . $acl . "\n";
 201     print $output unless $QUIET;
 202     print LOG $output if $LOGFILE;
 203 }
 204
 205 # Run diff on two files if we're configured to do so and they're both text
 206 # files.  Print the diff output if it's under the configured limit; otherwise
 207 # print a message saying the output has been suppressed.
 208 sub print_diff ( $$ ) {
 209     my ($old, $new) = @_;
 210     return '' if $NODIFF;
 211     return '' unless (-T $old && -T $new);
 212
 213     # Fork diff carefully.
 214     my $pid = open (DIFF, '-|');
 215     if (!defined $pid) {
 216         die "$0: cannot fork: $!\n";
 217     } elsif ($pid == 0) {
 218         open (STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
 219         exec ($DIFF, '-u', $old, $new)
 220             or die "$0: cannot exec $DIFF -u $old $new: $!\n";
 221     }
 222
 223     # Gather the output.
 224     local $_;
 225     my (@diff, $diff);
 226     while (<DIFF>) {
 227         s{(\s)(?:\Q$ROOTRO\E|\Q$ROOTRW\E)} {$1...} if $. <= 2;
 228         push (@diff, $_) if $. <= $MAXDIFF;
 229     }
 230     my $output;
 231     if ($. > $MAXDIFF) {
 232         $output = "    LARGE diff output suppressed, $. lines\n";
 233     } else {
 234         $output = join ('', @diff);
 235     }
 236     close DIFF;
 237     print $output unless $QUIET;
 238     print LOG $output if $LOGFILE;
 239 }
 240
 241 ##############################################################################
 242 # AFS information
 243 ##############################################################################
 244
 245 # Given a mount point, get the volume name of the volume mounted there or
 246 # undef if it is not a mount point.
 247 sub lsmount ( $ ) {
 248     my ($path) = @_;
 249     my $pid = open (LSMOUNT, '-|');
 250     if (!defined $pid) {
 251         die "$0: cannot fork: $!\n";
 252     } elsif ($pid == 0) {
 253         open (STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
 254         exec ($FS, 'lsmount', $path)
 255             or die "$0: cannot exec $FS lsmount for $path: $!\n";
 256     }
 257     local $/;
 258     my $output = <LSMOUNT>;
 259     close LSMOUNT;
 260     print map { "===> $_ ($?)\n" } split (/\n/, $output) if $DEBUG;
 261     return if ($? != 0);
 262     my ($name) =
 263         ($output =~ /^\S+ is a mount point for volume \'[%\#](\S+)\'$/);
 264     return $name;
 265 }
 266
 267 # Get the ACL for a directory, returning the ACL as a dense, comma-separated
 268 # string.  Map full privileges to "all" and prefix negative rights with --
 269 # (which may be theoretically ambiguous, but shouldn't be a problem in
 270 # practice).  Returns NOT_IN_AFS if the path is apparently not in AFS.
 271 sub getacl ( $ ) {
 272     my ($dir) = @_;
 273
 274     # Fork off fs listacl carefully.
 275     my $pid = open (LISTACL, '-|');
 276     if (!defined $pid) {
 277         die "$0: cannot fork: $!\n";
 278     } elsif ($pid == 0) {
 279         open (STDERR, '>&STDOUT') or die "$0: cannot dup stdout: $!\n";
 280         exec ($FS, 'listacl', $dir)
 281             or die "$0: cannot exec $FS listacl for $dir: $!\n";
 282     }
 283
 284     # Read the results.  The first line is either a header or an error
 285     # message; if it's an error message, check to see if it says that the path
 286     # isn't in AFS and return NOT_IN_AFS in that situation.  Otherwise, look
 287     # for the "Normal rights:" and "Negative rights:" headers.  Assume that
 288     # all negative rights come after all normal rights.
 289     local $_;
 290     my $error = <LISTACL>;
 291     if ($error =~ /it is possible that .* is not in AFS/) {
 292         return 'NOT_IN_AFS';
 293     }
 294     my ($acl, $prefix) = ('', '');
 295     while (<LISTACL>) {
 296         next if /Normal rights:/;
 297         if (/Negative rights:/) {
 298             $prefix = '--';
 299             next;
 300         }
 301         my ($pts, $perms) = split;
 302         $perms = 'all' if $perms eq 'rlidwka';
 303         $acl .= $prefix . $pts . '=' . $perms . ',';
 304     }
 305     close LISTACL;
 306     if ($? != 0) {
 307         warn $error;
 308         die "$0: $FS listacl failed for $dir with status ", ($? >> 8), "\n";
 309     }
 310     $acl =~ s/,$//;
 311     return $acl;
 312 }
 313
 314 ##############################################################################
 315 # Analysis
 316 ##############################################################################
 317
 318 # Gather information about a file and return it as a hash.  The keys of the
 319 # hash are set as follows:  stat gets a File::stat object for it, islink and
 320 # isdir are booleans indicating whether the file is a link or a directory,
 321 # link holds the value of the link if it is a link, volume holds the volume it
 322 # is a mount point for if it is a mount point and undef otherwise, and acl
 323 # holds the ACL for the directory if it is a directory.
 324 sub examine ( $ ) {
 325     my ($file) = @_;
 326     my %info;
 327     $info{name} = $file;
 328     $info{stat} = lstat $file;
 329     if ($info{stat}) {
 330         $info{islink} = -l _;
 331         $info{isdir} = -d _;
 332         $info{link} = readlink $file if $info{islink};
 333         if ($info{isdir}) {
 334             $info{volume} = lsmount $file;
 335             my $isroot = ($file eq $ROOTRW || $file eq $ROOTRO);
 336             if (!defined $info{volume} || $CROSSMOUNT || $isroot) {
 337                 $info{acl} = getacl $file;
 338             }
 339         }
 340     }
 341     return %info;
 342 }
 343
 344 # Print out the appropriate information for something brand new that has
 345 # appeared (no corresponding file in the read-only path).
 346 sub compare_new ( $ ) {
 347     print "==> Comparing new file\n" if $DEBUG;
 348     my %info = %{ $_[0] };
 349     if ($info{islink}) {
 350         print_name ('New link', $info{name});
 351         revert ('delete', $info{bname});
 352         apply  ('link', $info{link}, $info{bname});
 353     } elsif (defined $info{volume}) {
 354         print_name ('New mountpoint', $info{name}, "-> #$info{volume}");
 355         revert ('system', $FS, 'rmmount', $info{bname});
 356         apply  ('system', $FS, 'mkmount', $info{bname}, $info{volume});
 357     } elsif ($info{isdir}) {
 358         print_name ('New directory', $info{name});
 359         revert ('system', '/bin/rm', '-rf', $info{bname});
 360         apply  ('dir', $info{bname}, bundle_mode ($info{stat}));
 361         apply  ('system', bundle_setacl ($info{bname}, $info{acl}));
 362     } else {
 363         print_name ('New', $info{name});
 364         my $saved = changes ($info{bname}, 'new');
 365         revert ('delete', $info{bname});
 366         apply  ('file', $saved, $info{bname});
 367     }
 368     print_ls ('', \%info) unless defined $info{volume};
 369     print_acl ('is', $info{acl}) if $info{isdir} && $info{acl};
 370 }
 371
 372 # Print out the appropriate information when the read/write volume has a link.
 373 # Takes the information for both the read/write and read-only versions.
 374 sub compare_link ( $$ ) {
 375     print "==> Comparing link\n" if $DEBUG;
 376     my %rwinfo = %{ $_[0] };
 377     my %roinfo = %{ $_[1] };
 378     if ($roinfo{islink}) {
 379         return if $rwinfo{link} eq $roinfo{link};
 380         print_name ('Link change', $rwinfo{name});
 381         revert ('link', $roinfo{link}, $rwinfo{bname});
 382         apply  ('link', $rwinfo{link}, $rwinfo{bname});
 383     } elsif (defined $roinfo{volume}) {
 384         print_name ('Mountpoint replaced by link', $rwinfo{name});
 385         revert ('delete', $rwinfo{bname});
 386         revert ('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
 387         apply  ('system', $FS, 'rmmount', $rwinfo{bname});
 388         apply  ('link', $rwinfo{link}, $rwinfo{bname});
 389     } elsif ($roinfo{isdir}) {
 390         print_name ('Directory replaced by link', $rwinfo{name});
 391         revert ('delete', $rwinfo{bname});
 392         revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 393         apply  ('system', '/bin/rm', '-rf', $rwinfo{bname});
 394         apply  ('link', $rwinfo{link}, $rwinfo{bname});
 395     } else {
 396         print_name ('Non-link replaced by link', $rwinfo{name});
 397         my $saved = changes ($roinfo{bname}, 'old');
 398         revert ('file', $saved, $rwinfo{bname});
 399         apply  ('link', $rwinfo{link}, $rwinfo{bname});
 400     }
 401     print_ls ('WAS', \%roinfo);
 402     print_ls ('NOW', \%rwinfo);
 403 }
 404
 405 # Print out the appropriate information when the read/write volume has a mount
 406 # point.  Takes the information for both the read/write and read-only
 407 # versions.
 408 sub compare_mount ( $$ ) {
 409     print "==> Comparing mountpoint\n" if $DEBUG;
 410     my %rwinfo = %{ $_[0] };
 411     my %roinfo = %{ $_[1] };
 412     if ($roinfo{islink}) {
 413         print_name ('Link replaced by mountpoint', $rwinfo{name});
 414         print_ls ('WAS', \%roinfo);
 415         print_ls ('NOW', \%rwinfo);
 416         revert ('system', $FS, 'rmmount', $rwinfo{bname});
 417         revert ('link', $roinfo{link}, $rwinfo{bname});
 418         apply  ('delete', $rwinfo{bname});
 419         apply  ('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
 420     } elsif (defined $roinfo{volume}) {
 421         if ($rwinfo{volume} ne $roinfo{volume} && $rwinfo{name} ne $ROOTRW) {
 422             print_name ('Mountpoint change', $rwinfo{name});
 423             print_ls ('WAS', \%roinfo);
 424             print_ls ('NOW', \%rwinfo);
 425             revert ('system', $FS, 'rmmount', $rwinfo{bname});
 426             revert ('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
 427             apply  ('system', $FS, 'rmmount', $rwinfo{bname});
 428             apply  ('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
 429         } elsif ($rwinfo{name} eq $ROOTRW || $CROSSMOUNT) {
 430             return unless $rwinfo{stat};
 431             my $old = lslout ($roinfo{stat}, 1);
 432             my $new = lslout ($rwinfo{stat}, 1);
 433             if ($new ne $old) {
 434                 print_name ('Changed directory', $rwinfo{name});
 435                 print_ls ('WAS', \%roinfo, 1);
 436                 print_ls ('NOW', \%rwinfo, 1);
 437                 revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 438                 apply  ('dir', $rwinfo{bname}, bundle_mode ($rwinfo{stat}));
 439             }
 440             return if $rwinfo{acl} eq $roinfo{acl};
 441             print_name ('ACL changed', $rwinfo{name});
 442             print_acl ('WAS', $roinfo{acl});
 443             print_acl ('NOW', $rwinfo{acl});
 444             revert ('system', bundle_setacl ($rwinfo{bname}, $roinfo{acl}));
 445             apply  ('system', bundle_setacl ($rwinfo{bname}, $rwinfo{acl}));
 446         }
 447     } elsif ($roinfo{isdir}) {
 448         print_name ('Directory replacd by mountpoint', $rwinfo{name});
 449         print_ls ('WAS', \%roinfo);
 450         print_ls ('NOW', \%rwinfo);
 451         revert ('system', $FS, 'rmmount', $rwinfo{bname});
 452         revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 453         apply  ('system', '/bin/rm', '-rf', $rwinfo{bname});
 454         apply  ('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
 455     } else {
 456         print_name ('File replaced by mountpoint', $rwinfo{name});
 457         print_ls ('WAS', \%roinfo);
 458         print_ls ('NOW', \%rwinfo);
 459         my $saved = changes ($roinfo{bname}, 'old');
 460         revert ('system', $FS, 'rmmount', $rwinfo{bname});
 461         revert ('file', $saved, $rwinfo{bname});
 462         apply  ('delete', $rwinfo{bname});
 463         apply  ('system', $FS, 'mkmount', $rwinfo{bname}, $rwinfo{volume});
 464     }
 465 }
 466
 467 # Print out the appropriate information when the read/write volume has a
 468 # directory.  Takes the information for both the read/write and read-only
 469 # versions.
 470 sub compare_dir ( $$ ) {
 471     print "==> Comparing directory\n" if $DEBUG;
 472     my %rwinfo = %{ $_[0] };
 473     my %roinfo = %{ $_[1] };
 474     if ($roinfo{islink}) {
 475         print_name ('Link replaced by directory', $rwinfo{name});
 476         print_ls ('WAS', \%roinfo);
 477         print_ls ('NOW', \%rwinfo);
 478         revert ('system', '/bin/rm', '-rf', $rwinfo{bname});
 479         revert ('link', $roinfo{link}, $rwinfo{bname});
 480         apply  ('delete', $rwinfo{bname});
 481         apply  ('dir', $rwinfo{bname}, bundle_mode ($rwinfo{stat}));
 482     } elsif (defined $roinfo{volume}) {
 483         print_name ('Mountpoint replaced by directory', $rwinfo{name});
 484         print_ls ('WAS', \%roinfo);
 485         print_ls ('NOW', \%rwinfo);
 486         revert ('system', '/bin/rm', '-rf', $rwinfo{bname});
 487         revert ('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
 488         apply  ('system', $FS, 'rmmount', $rwinfo{bname});
 489         apply  ('dir', $rwinfo{bname}, bundle_mode ($rwinfo{stat}));
 490     } elsif ($roinfo{isdir}) {
 491         my $old = lslout ($roinfo{stat}, 1);
 492         my $new = lslout ($rwinfo{stat}, 1);
 493         if ($new ne $old) {
 494             print_name ('Changed directory', $rwinfo{name});
 495             print_ls ('WAS', \%roinfo);
 496             print_ls ('NOW', \%rwinfo);
 497             revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 498             apply  ('dir', $rwinfo{bname}, bundle_mode ($rwinfo{stat}));
 499         }
 500         if ($rwinfo{acl} ne $roinfo{acl}) {
 501             print_name ('ACL changed', $rwinfo{name});
 502             print_acl ('WAS', $roinfo{acl});
 503             print_acl ('NOW', $rwinfo{acl});
 504             revert ('system', bundle_setacl ($rwinfo{bname}, $roinfo{acl}));
 505             apply  ('system', bundle_setacl ($rwinfo{bname}, $rwinfo{acl}));
 506         }
 507     } else {
 508         print_name ('File replaced by directory', $rwinfo{name});
 509         print_ls ('WAS', \%roinfo);
 510         print_ls ('NOW', \%rwinfo);
 511         my $saved = changes ($roinfo{bname}, 'old');
 512         revert ('system', '/bin/rm', '-rf', $rwinfo{bname});
 513         revert ('file', $saved, $rwinfo{bname});
 514         apply  ('delete', $rwinfo{bname});
 515         apply  ('dir', $rwinfo{bname}, bundle_mode ($rwinfo{stat}));
 516     }
 517 }
 518
 519 # Print out the appropriate information when the read/write volume has a
 520 # regular file.  Takes the information for both the read/write and read-only
 521 # versions.
 522 sub compare_file ( $$ ) {
 523     print "==> Comparing file\n" if $DEBUG;
 524     my %rwinfo = %{ $_[0] };
 525     my %roinfo = %{ $_[1] };
 526     if ($roinfo{islink}) {
 527         print_name ('Link replaced by non-link', $rwinfo{name});
 528         print_ls ('WAS', \%roinfo);
 529         print_ls ('NOW', \%rwinfo);
 530         my $saved = changes ($rwinfo{bname}, 'new');
 531         revert ('link', $roinfo{link}, $rwinfo{bname});
 532         apply  ('file', $saved, $rwinfo{bname});
 533     } elsif (defined $roinfo{volume}) {
 534         print_name ('Mountpoint replaced by file', $rwinfo{name});
 535         print_ls ('WAS', \%roinfo);
 536         print_ls ('NOW', \%rwinfo);
 537         my $saved = changes ($rwinfo{bname}, 'new');
 538         revert ('delete', $rwinfo{bname});
 539         revert ('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
 540         apply  ('system', $FS, 'rmmount', $rwinfo{bname});
 541         apply  ('file', $saved, $rwinfo{bname});
 542     } elsif ($roinfo{isdir}) {
 543         print_name ('Directory replaced by file', $rwinfo{name});
 544         print_ls ('WAS', \%roinfo);
 545         print_ls ('NOW', \%rwinfo);
 546         my $saved = changes ($rwinfo{bname}, 'new');
 547         revert ('delete', $rwinfo{bname});
 548         revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 549         apply  ('system', '/bin/rm', '-rf', $rwinfo{bname});
 550         apply  ('file', $saved, $rwinfo{bname});
 551     } else {
 552         my $newls = lslout ($rwinfo{stat});
 553         my $oldls = lslout ($roinfo{stat});
 554         return unless $newls ne $oldls;
 555         print_name ('Changed', $rwinfo{name});
 556         print_ls ('WAS', \%roinfo);
 557         print_ls ('NOW', \%rwinfo);
 558         print_diff ($roinfo{name}, $rwinfo{name});
 559         my $old = changes ($roinfo{bname}, 'old');
 560         my $new = changes ($rwinfo{bname}, 'new');
 561         revert ('file', $old, $rwinfo{bname});
 562         apply  ('file', $new, $rwinfo{bname});
 563     }
 564 }
 565
 566 # Compare in the forward direction (read/write to read-only).  This will pick
 567 # up file creations and changes, but will not pick up file deletions.  This
 568 # function is called for each file found in the read/write volume.
 569 sub analyze_forward {
 570     print "=> Inspecting $File::Find::name\n" if $DEBUG;
 571     my $rw = $File::Find::name;
 572     my $ro = $rw;
 573     $ro =~ s(^\Q$ROOTRW\E)($ROOTRO);
 574     my %rwinfo = examine ($rw);
 575     my %roinfo = examine ($ro);
 576     $rwinfo{bname} = bundle_name ($rwinfo{name}, $ROOTRW, 'DEST');
 577     $roinfo{bname} = bundle_name ($roinfo{name}, $ROOTRO, 'ORIG');
 578
 579     # If the stat failed, that probably means that we have a mount point to a
 580     # volume that doesn't exist.  Handle that case specially.
 581     unless ($rwinfo{stat}) {
 582         $rwinfo{volume} = lsmount $rw;
 583         return unless defined $rwinfo{volume};
 584     }
 585
 586     # If this was a mount point, prune here.
 587     $File::Find::prune = 1
 588         if ($rw ne $ROOTRW && $rwinfo{volume} && !$CROSSMOUNT);
 589     $File::Find::prune = 1
 590         if ($ro ne $ROOTRO && $roinfo{volume} && !$CROSSMOUNT);
 591
 592     # Do the analysis, or rather call all the individual functions that do the
 593     # analysis.
 594     if    (!$roinfo{stat})          { compare_new (\%rwinfo)             }
 595     elsif ($rwinfo{islink})         { compare_link (\%rwinfo, \%roinfo)  }
 596     elsif (defined $rwinfo{volume}) { compare_mount (\%rwinfo, \%roinfo) }
 597     elsif ($rwinfo{isdir})          { compare_dir (\%rwinfo, \%roinfo)   }
 598     else                            { compare_file (\%rwinfo, \%roinfo)  }
 599 }
 600
 601 # Compare in the reverse direction (read-only to read/write).  The only thing
 602 # we pick up here are deletions, so we ignore any case where the object exists
 603 # in the read/write volume (since we would have reported on it during the
 604 # forward pass).  This function is called for each file found in the read-only
 605 # volume.
 606 sub analyze_reverse {
 607     print "=> Inspecting $File::Find::name\n" if $DEBUG;
 608     my $ro = $File::Find::name;
 609     my $rw = $ro;
 610     $rw =~ s(^\Q$ROOTRO\E)($ROOTRW);
 611     my %rwinfo = examine ($rw);
 612
 613     # If this was a mount point, prune here.  Note that we prune based on the
 614     # read/write path because we want to be able to avoid the stat of the
 615     # read-only side if the read/write side exists.  Because of the forward
 616     # pass, this won't cause us to miss anything significant.
 617     $File::Find::prune = 1
 618         if ($rw ne $ROOTRW && $rwinfo{volume} && !$CROSSMOUNT);
 619     return if $rwinfo{stat};
 620
 621     # Now check the read-only side.  We also prune if the read-only side is a
 622     # mount point, of course.
 623     my %roinfo = examine ($ro);
 624     $File::Find::prune = 1
 625         if ($ro ne $ROOTRO && $roinfo{volume} && !$CROSSMOUNT);
 626     $rwinfo{bname} = bundle_name ($rwinfo{name}, $ROOTRW, 'DEST');
 627     $roinfo{bname} = bundle_name ($roinfo{name}, $ROOTRO, 'ORIG');
 628
 629     # If stat failed, that probably means that we have a mount point to a
 630     # volume that no longer exists.  Handle that case as a special situation.
 631     unless ($roinfo{stat}) {
 632         $roinfo{volume} = lsmount $ro;
 633         return unless defined $roinfo{volume};
 634     }
 635
 636     # Analyze the difference and report appropriately.
 637     if ($roinfo{islink}) {
 638         print_name ('Deleted link', $rwinfo{name});
 639         print_ls ('', \%roinfo);
 640         revert ('link', $roinfo{link}, $rwinfo{bname});
 641         apply  ('delete', $rwinfo{bname});
 642     } elsif (defined $roinfo{volume}) {
 643         print_name ('Deleted mountpoint', $rwinfo{name},
 644                     "-> #$roinfo{volume}");
 645         revert ('system', $FS, 'mkmount', $rwinfo{bname}, $roinfo{volume});
 646         apply  ('system', $FS, 'rmmount', $rwinfo{bname});
 647     } elsif ($roinfo{isdir}) {
 648         print_name ('Deleted directory', $rwinfo{name});
 649         revert ('dir', $rwinfo{bname}, bundle_mode ($roinfo{stat}));
 650         apply  ('system', '/bin/rm', '-rf', $rwinfo{bname});
 651     } else {
 652         print_name ('Deleted', $rwinfo{name});
 653         my $saved = changes ($roinfo{bname}, 'old');
 654         revert ('file', $saved, $rwinfo{bname});
 655         apply  ('delete', $rwinfo{bname});
 656     }
 657 }
 658
 659 ##############################################################################
 660 # Main routine
 661 ##############################################################################
 662
 663 # Trim extraneous garbage from the path.
 664 my $fullpath = $0;
 665 $0 =~ s%.*/%%;
 666
 667 # Make sure we get output in the right order.
 668 $| = 1;
 669
 670 # Parse our options.
 671 my ($help, $logfile, $nolog, $version);
 672 Getopt::Long::config ('bundling');
 673 GetOptions ('cross-mounts|C'     => \$CROSSMOUNT,
 674             'change-dir|c=s'     => \$CHANGEDIR,
 675             'debug|D'            => \$DEBUG,
 676             'max-diff-lines|d=i' => \$MAXDIFF,
 677             'help|h'             => \$help,
 678             'no-log|L'           => \$nolog,
 679             'log-file|l=s'       => \$logfile,
 680             'munge|m'            => \$MUNGE,
 681             'quiet|q'            => \$QUIET,
 682             'suppress-diff|s'    => \$NODIFF,
 683             'version|v'          => \$version) or exit 1;
 684 if ($help) {
 685     print "Feeding myself to perldoc, please wait....\n";
 686     exec ('perldoc', '-t', $fullpath);
 687 } elsif ($version) {
 688     my $version = join (' ', (split (' ', $ID))[1..3]);
 689     $version =~ s/,v\b//;
 690     $version =~ s/(\S+)$/($1)/;
 691     $version =~ tr%/%-%;
 692     print $version, "\n";
 693     exit 0;
 694 }
 695 $LOGFILE = $logfile if $logfile;
 696
 697 # Check the directories we're given.  If the -m option is used, we should
 698 # instead have a single argument naming the volume and will be mounting it in
 699 # the current directory.
 700 die "Usage: $0 [-CDhLmqsv] [-c <change>] [-d <n>] [-l <log>] <rw> [<ro>]\n"
 701     if (@ARGV > 2 || @ARGV < 1);
 702 my ($rw, $ro, $volume, $mounted);
 703 if (@ARGV == 1 && $ARGV[0] !~ m%/%) {
 704     $MUNGE = 1;
 705     $volume = $ARGV[0];
 706     $volume =~ s/\.readonly$//;
 707     my $rovolume = $volume . '.readonly';
 708     $rw = "frak-$volume";
 709     $ro = "frak-$rovolume";
 710     system ($FS, 'mkmount', $ro, $rovolume) == 0
 711         or die "$0: failed to create mount for $rovolume\n";
 712     system ($FS, 'mkmount', '-rw', $rw, $volume) == 0
 713         or die "$0: failed to create mount for $volume\n";
 714     $mounted = 1;
 715     $LOGFILE = $volume unless ($nolog || $logfile);
 716 } else {
 717     ($rw, $ro) = @ARGV;
 718     if (@ARGV == 1 && $rw =~ m%/afs/[^.]%) {
 719         warn "$0: only argument specifies a read-only path, correcting\n";
 720         $rw =~ s%/afs/%/afs/.%;
 721     }
 722     unless ($ro) {
 723         $ro = $rw;
 724         $ro =~ s%/afs/\.%/afs/%;
 725         if ($rw eq $ro) {
 726             die "$0: cannot intuit read-only path from read/write path\n";
 727         }
 728     }
 729     $volume = lsmount ($rw);
 730     unless (defined $volume) {
 731         warn "$0: $rw is not a mountpoint for its volume\n";
 732     }
 733 }
 734
 735 # Get rid of any trailing slashes.
 736 s%/+$%% for ($rw, $ro);
 737
 738 # Check the validity of the read/write directory.
 739 die "$0: read/write path $rw not found or not a directory\n"
 740     unless -d $rw;
 741
 742 # Set the global variables.
 743 ($ROOTRW, $ROOTRO) = ($rw, $ro);
 744
 745 # If a changedir is requested, set up the file handles and files.
 746 if ($CHANGEDIR) {
 747     open (CHANGES, "> $CHANGEDIR/changes.b")
 748         or die "$0: cannot create $CHANGEDIR/changes.b: $!\n";
 749     open (REVERT, "> $CHANGEDIR/revert.b")
 750         or die "$0: cannot create $CHANGEDIR/revert.b: $!\n";
 751     open (APPLY, "> $CHANGEDIR/apply.b")
 752         or die "$0: cannot create $CHANGEDIR/apply.b: $!\n";
 753     mkdir ("$CHANGEDIR/old", 0755)
 754         or die "$0: cannot create $CHANGEDIR/old: $!\n";
 755     mkdir ("$CHANGEDIR/new", 0755)
 756         or die "$0: cannot create $CHANGEDIR/new: $!\n";
 757     print CHANGES "ORIG=", bundle_quote ($ROOTRO), "\n";
 758     print CHANGES "DEST=", bundle_quote ($ROOTRW), "\n";
 759     print REVERT  "ORIG=", bundle_quote ($ROOTRO), "\n";
 760     print REVERT  "DEST=", bundle_quote ($ROOTRW), "\n";
 761     print APPLY   "ORIG=", bundle_quote ($ROOTRO), "\n";
 762     print APPLY   "DEST=", bundle_quote ($ROOTRW), "\n";
 763 }
 764
 765 # If a log is requested, create the log file.
 766 if ($LOGFILE) {
 767     open (LOG, "> $LOGFILE")
 768         or die "$0: cannot create log file $LOGFILE: $!\n";
 769 }
 770
 771 # Print the header if we have a volume.
 772 header ($volume) if defined $volume;
 773
 774 # Do the actual work.
 775 $File::Find::dont_use_nlink = 1;
 776 find ({ wanted => \&analyze_forward, no_chdir => 1 }, $ROOTRW);
 777 print "\n" unless $QUIET;
 778 print LOG "\n" if $LOGFILE;
 779 find ({ wanted => \&analyze_reverse, no_chdir => 1 }, $ROOTRO);
 780 print "\n" unless $QUIET;
 781 print LOG "\n" if $LOGFILE;
 782
 783 # Remove the mount points if we created them.  Try to do this even if we
 784 # exited on error.
 785 END {
 786     if ($mounted) {
 787         system ($FS, 'rmmount', "frak-$volume.readonly") == 0
 788             or warn "$0: cannot remove ro mount point for volume\n";
 789         system ($FS, 'rmmount', "frak-$volume") == 0
 790             or warn "$0: cannot remove rw mount point for volume\n";
 791     }
 792 }
 793
 794 __END__
 795
 796 ############################################################################
 797 # Documentation
 798 ############################################################################
 799
 800 =head1 NAME
 801
 802 frak - Show changes between two AFS trees
 803
 804 =head1 SYNOPSIS
 805
 806 frak [B<-CDhLmqsv>] [B<-c> I<changedir>] [B<-d> I<max-diff-lines>] [B<-l>
 807 I<logfile>] (I<volume> | I<rw-path> [ I<ro-path> ])
 808
 809 =head1 DESCRIPTION
 810
 811 B<frak> is a tool for comparing the structure and contents of two directory
 812 trees in AFS.  Its most common use is to determine the changes in a
 813 read/write AFS volume relative to the read-only copy of the same volume, to
 814 ensure that it's safe to release, but it can be used to compare any two
 815 arbitrary AFS trees.  It can even be used in a limited fashion to compare
 816 non-AFS trees, although in that case C<diff -r> may be more appropriate.
 817
 818 B<frak> understands mount points and directory ACLs and will detect changes
 819 in those as well as more typical changes in file size, permissions, or
 820 existence.  It also knows not to cross mount points (unless given the B<-C>
 821 option).  Note that two files with the same permissions and the same size
 822 will be considered identical; the file is not actually compared with diff if
 823 its other information matches.
 824
 825 If two files are different and are determined to be text files (using the
 826 C<-T> probe in Perl; see L<perlfunc> for more information), C<diff -u> will
 827 be run on the two files.  This output will be included in the B<frak> output
 828 provided it's less than 100 lines long (controllable with B<-d>).
 829 Otherwise, just the length of the diff in lines will be given.  Diffs can be
 830 suppressed completely with B<-s>.
 831
 832 The paths to compare may be specified in three ways.  A volume name can be
 833 given as the sole argument (distinguished from a path by the fact that it
 834 doesn't contain a C</>).  In this case, the read-only and read-write
 835 versions of that volume will be mounted in the current working directory (so
 836 the current working directory must be in AFS), as F<frak-I<volume>> and
 837 F<frak-I<volume>.readonly>, and then compared.  A path may be given as the
 838 sole argument, in which case it is taken to be the path to the read-write
 839 version of the tree and should begin with C</afs/.>.  It will be compared
 840 against the read-only path to the same tree, formed by removing the period
 841 after C</afs/>.  Or, finally, two paths may be given, and they will be taken
 842 to be the read-write path (the newer tree) and the read-only path (the older
 843 tree) respectively.  Please note that this is the exact opposite order from
 844 what one would pass to B<diff>.
 845
 846 If a volume is specified, B<frak> will by default log the output to a file
 847 named after the volume in the current directory, as well as printing the
 848 output to standard output.  To suppress the file log, use B<-L>.  To
 849 suppress the output to standard out, use B<-q>.  The name and location of
 850 the log file can be changed with B<-l>.  If a path is specified, B<frak>
 851 will by default only print to standard output.  To also log to a file,
 852 specify a log file location with B<-l>.  In either case, the log file will
 853 be overwritten if it already exists.
 854
 855 If a volume is specified, paths in the output will be shown relative to the
 856 root of the volume.  If a path is specified, paths in the output will be
 857 complete paths unless B<-m> is given.  If B<-m> is given, paths will be
 858 relative to the root of the tree specified by the path given on the command
 859 line.
 860
 861 =head1 OPTIONS
 862
 863 =over 4
 864
 865 =item B<-C>, B<--cross-mounts>
 866
 867 Normally, B<frak> will never cross a mount point.  If this option is given,
 868 it will keep comparing through mount points.  Be careful when using this
 869 option, since B<frak> will happily recurse through all AFS file systems in
 870 the world, and remember that circular path structures are possible in AFS.
 871 B<frak> does no checking to make sure that it doesn't revisit the same
 872 volume endlessly.
 873
 874 =item B<-c> I<changedir>, B<--change-dir>=I<changedir>
 875
 876 When given this option, B<frak> creates three bundles I<changedir>, as well
 877 as directories named F<new> and F<old>.  The first bundle is named
 878 F<changes.b>, which if run will populate the F<new> and F<old> directories
 879 with all of the files that have changed between the two trees.  The second
 880 bundle, F<revert.b>, will use those files to revert the changes to the
 881 read-write path so that it matches the read-only path.  The third bundle,
 882 F<apply.b>, will reapply the changes to the read-write path so that it
 883 returns to the state that it was in before B<frak> was run.
 884
 885 The intended use of this feature is to make it possible to back out
 886 arbitrary changes made to the read-write path of a volume, release the
 887 volume, and then put those changes back.  Please note that this feature is
 888 not as well-tested as the rest of B<frak>, and the bundles should be
 889 reviewed very carefully before use.  Note also that B<frak> can be used
 890 again after F<revert.b> has been applied, to make sure that the read-write
 891 volume really does match the read-only volume.
 892
 893 This option only really makes sense when used with a path, rather than a
 894 volume, on the command line.  Otherwise, the bundles will use paths relative
 895 to the temporary mount points created by B<frak>, which isn't as useful.
 896
 897 =item B<-D>, B<--debug>
 898
 899 Display additional debugging information.  This is mostly only useful for
 900 debugging B<frak>.
 901
 902 =item B<-d> I<max-diff-lines>, B<--max-diff-lines>=I<max-diff-lines>
 903
 904 Limit the number of lines of diffs shown for changed files to
 905 I<max-diff-lines>.  The default is 100.  Diffs with longer than that number
 906 of lines will be replaced with a message saying how many total lines the
 907 diff had.
 908
 909 =item B<-h>, B<--help>
 910
 911 Print out this documentation (which is done simply by feeding the script to
 912 C<perldoc -t>).
 913
 914 =item B<-L>, B<--no-log>
 915
 916 Suppress the default logging to a file that occurs if a volume rather than a
 917 path is specified on the command line.  The output will only be sent to
 918 standard output.
 919
 920 =item B<-l> I<log>, B<--log-file>=I<log>
 921
 922 Log the B<frak> output to I<log> as well as to standard output.  If a volume
 923 was specified on the command line, this overrides the default log file name
 924 (the name of the volume).  If a path was specified, this enables logging to
 925 a file.
 926
 927 =item B<-m>, B<--munge>
 928
 929 Only meaningful when a path was specified on the command line.  Tells
 930 B<frak> to show paths in the output relative to the top of the tree
 931 specified on the command line, rather than showing absolute paths.
 932
 933 =item B<-q>, B<--quiet>
 934
 935 Suppress the normal output to standard output.  B<frak> output will only be
 936 sent to the log file, if any.
 937
 938 =item B<-s>, B<--suppress-diffs>
 939
 940 Suppress diffs for changed files.  This also turns off the check to see if
 941 changed files are binary or text, and will make B<frak> run somewhat faster.
 942
 943 =item B<-v>, B<--version>
 944
 945 Print out the version of B<frak> and exit.
 946
 947 =back
 948
 949 =head1 EXAMPLES
 950
 951 Compare the read-write and read-only copies of the volume C<pubsw>, mounting
 952 both in the current directory to do the comparison, and putting a copy of
 953 the output into the file F<pubsw> in the current directory:
 954
 955     frak pubsw
 956
 957 Do the same, but store the output in F</tmp/pubsw.log>:
 958
 959     frak -l /tmp/pubsw.log pubsw
 960
 961 The same, but don't print anything other than errors to standard output:
 962
 963     frak -q -l /tmp/pubsw.log pubsw
 964
 965 The same, but only print the output to standard output:
 966
 967     frak -L pubsw
 968
 969 Compare the path F</afs/.ir.stanford.edu/pubsw> to
 970 F</afs/ir.stanford.edu/pubsw>, printing the output to standard output.
 971
 972     frak /afs/.ir.stanford.edu/pubsw
 973
 974 A completely equivalent way to do the same thing:
 975
 976     frak /afs/.ir.stanford.edu/pubsw /afs/ir.stanford.edu/pubsw
 977
 978 Do the same, but log the output to F</tmp/pubsw.log>:
 979
 980     frak -l /tmp/pubsw.log /afs/.ir.stanford.edu/pubsw
 981
 982 Compare the read-write and read-only copies of the volume C<pubsw>, writing
 983 the change bundles into the subdirectory F<changes> of the current
 984 directory:
 985
 986     frak -c changes /afs/.ir.stanford.edu/pubsw
 987
 988 One can then cd to the F<changes> directory and run C<changes.b>, and then
 989 C<revert.b> to revert the changes to the read-write path.  At some point
 990 later, one could run C<apply.b> to replace the changes.
 991
 992 =head1 SEE ALSO
 993
 994 bundle(1), diff(1)
 995
 996 The current version of this program is available from its web page at
 997 L<http://www.eyrie.org/~eagle/software/frak/>.
 998
 999 =head1 AUTHOR
1000
1001 Originally written by Neil Crellin <neilc@stanford.edu>.  Substantially
1002 reorganized and rewritten by Russ Allbery <rra@stanford.edu>.
1003
1004 =head1 COPYRIGHT AND LICENSE
1005
1006 Copyright 1998, 1999, 2004 Board of Trustees, Leland Stanford Jr.
1007 University.
1008
1009 This program is free software; you may redistribute it and/or modify it
1010 under the same terms as Perl itself.
1011
1012 =cut