#!/usr/bin/perl -w
#
# $Id: fs-snapshot.pl,v 1.22 2003/01/13 05:28:43 jmates Exp $
#
# Copyright (c) 2002, Jeremy Mates.  This script is free software;
# you can redistribute it and/or modify it under the same terms as
# Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use File::Find;   # traverse a file tree
use Getopt::Std;  # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.22 $ ') =~ s/[^0-9.]//g;

my (%opts, $skip, $prune, $digest, $parent_fs_id);

# output columns; filepath *must* be the first option for
# comparison between different filesystems (so can sort)
my @option = qw(filepath);
my %option;  # for easier lookups

# these get expanded out if mentioned in the options list
# if no options supplied, D for "default" group will be enabled
my %option_group = (
  'D' => [qw(type mode uname gname size mtime ctime link)],
  'A' => [
    qw(atime blksize blocks ctime devnum gid gname inode link md5 mode mtime nlink rdev size type uid uname)
  ],
  'C' => [qw(type mode uid gid devnum inode size mtime ctime nlink link md5)],
);

# type mappings.  if you change these, review code for dependancies
# (e.g. for softlink readlink check)
my %filetype = (
  '0010000' => 'p',
  '0020000' => 'c',
  '0040000' => 'd',
  '0060000' => 'b',
  '0100000' => 'f',
  '0120000' => 'l',
  '0140000' => 's',
  '0160000' => 'w',
);

######################################################################
#
# MAIN

my @args = @ARGV;

# parse command-line options
getopts('h?s:p:o:qdX', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

my $quiet           = 1 if exists $opts{'q'};
my $one_file_system = 1 if exists $opts{'X'};

# output options
if (exists $opts{'o'}) {
  push @option,
   map { $option_group{$_} ? @{$option_group{$_}} : $_ } split /[, ]/,
   $opts{'o'};

} else {
  push @option, @{$option_group{'D'}};
}

{
  my %seen;
  @option = grep { not $seen{$_}++ } @option;

  @option{@option} = undef;  # quick lookup table of options
}

if (exists $option{'md5'}) {
  eval { require Digest::MD5; };

  unless ($@) {
    require Digest::MD5;

  } else {
    warn "Warning: Digest::MD5 not found, omitting md5\n"
     unless $quiet;

    @option = grep { $_ ne "md5" } @option;
    %option = ();
    @option{@option} = undef;
  }
}

# skip and prune are perl expressions eval'ed against the files
if (exists $opts{'s'}) {
  $skip = $opts{'s'};
}
if (exists $opts{'p'}) {
  $prune = $opts{'p'};
}

# read from STDIN if no args left
chomp(@ARGV = <STDIN>) unless @ARGV;

# and flag the help text if nothing from STDIN
help() unless @ARGV;

# init checksum-generating object
my $md5;
if (exists $option{'md5'}) {
  $md5 = Digest::MD5->new;
}

# print header information for output
print "# Version: $VERSION\n";
print "# Command: $0 @args\n";
print "# Options: @option\n";

my $parent;
for (@ARGV) {

  # need to recurse over dirs, otherwise list files
  if (-d) {
    $parent = $_;

    if ($one_file_system) {
      $parent_fs_id = (stat $parent)[0];
    }

    find(
      {
        wanted   => \&handle_file,
        no_chdir => 1,
      },
      $parent
    );
  } elsif (-e) {

    my @stat = lstat;

    # avoid other file systems, if required
    # TODO: ability to record in output where this happens?
    if ($one_file_system and $stat[0] != $parent_fs_id) {
      warn "Wrong Filesystem: ", $_, "\n" unless $quiet;
      $File::Find::prune = 1;
      return;
    }

    my %data;

    $data{'filepath'} = $_;

    $data{'devnum'} = $stat[0] if exists $option{'devnum'};
    $data{'inode'}  = $stat[1] if exists $option{'inode'};

    $data{'mode'} = sprintf("%04o", $stat[2] & 07777) if exists $option{'mode'};
    $data{'type'} = $filetype{sprintf("%07o", $stat[2] & 0170000)}
     if exists $option{'type'};

    $data{'nlink'} = $stat[3] if exists $option{'nlink'};

    $data{'uid'} = $stat[4] if exists $option{'uid'};
    $data{'uname'} = getpwuid($stat[4]) || $stat[4] if exists $option{'uname'};
    $data{'gid'} = $stat[5] if exists $option{'gid'};
    $data{'gname'} = getgrgid($stat[5]) || $stat[5] if exists $option{'gname'};

    $data{'rdev'} = $stat[6] if exists $option{'rdev'};
    $data{'size'} = $stat[7] if exists $option{'size'};

    $data{'atime'} = $stat[8]  if exists $option{'atime'};
    $data{'mtime'} = $stat[9]  if exists $option{'mtime'};
    $data{'ctime'} = $stat[10] if exists $option{'ctime'};

    $data{'blksize'} = $stat[11] if exists $option{'blksize'};
    $data{'blocks'}  = $stat[12] if exists $option{'blocks'};

    if (exists $option{'link'} and $data{'type'} eq 'l') {
      $data{'link'} = readlink $_;
    }

    if (exists $option{'md5'} and -f _) {
      $md5->reset;
      open FILE, $_ or warn "Problem opening $_ for md5: $!\n";
      binmode FILE;
      $data{'md5'} = $md5->addfile(*FILE)->hexdigest;
      close FILE;
    }

    for (@option) {
      print $data{$_} if exists $data{$_};
      print "\t" unless $option[$#option] eq $_;
    }
    print "\n";

  } else {

    warn "No such file: $_\n" unless $quiet;

  }
}

exit;

######################################################################
#
# SUBROUTINES

sub handle_file {

  # see whether file should be skipped over
  # TODO: this eliminates a dir from being pruned...
  if (defined $skip) {
    my $result = eval "return 1 if (" . $skip . ");";
    if ($@) {
      chomp $@;
      die "Error: skip eval failure: ", $@;  # croak on errors
    }
    if ($result) {
      warn "Skipped: ", $_, "\n" unless $quiet;
      return;
    }
  }

  my @stat = lstat;

  # avoid other file systems, if required
  # TODO: ability to record in output where this happens?
  if ($one_file_system and $stat[0] != $parent_fs_id) {
    warn "Wrong Filesystem: ", $_, "\n" unless $quiet;
    $File::Find::prune = 1;
    return;
  }

  my %data;

  $data{'filepath'} = $_;

  $data{'devnum'} = $stat[0] if exists $option{'devnum'};
  $data{'inode'}  = $stat[1] if exists $option{'inode'};

  $data{'mode'} = sprintf("%04o", $stat[2] & 07777) if exists $option{'mode'};
  $data{'type'} = $filetype{sprintf("%07o", $stat[2] & 0170000)}
   if exists $option{'type'};

  $data{'nlink'} = $stat[3] if exists $option{'nlink'};

  $data{'uid'} = $stat[4] if exists $option{'uid'};
  $data{'uname'} = getpwuid($stat[4]) || $stat[4] if exists $option{'uname'};
  $data{'gid'} = $stat[5] if exists $option{'gid'};
  $data{'gname'} = getgrgid($stat[5]) || $stat[5] if exists $option{'gname'};

  $data{'rdev'} = $stat[6] if exists $option{'rdev'};
  $data{'size'} = $stat[7] if exists $option{'size'};

  $data{'atime'} = $stat[8]  if exists $option{'atime'};
  $data{'mtime'} = $stat[9]  if exists $option{'mtime'};
  $data{'ctime'} = $stat[10] if exists $option{'ctime'};

  $data{'blksize'} = $stat[11] if exists $option{'blksize'};
  $data{'blocks'}  = $stat[12] if exists $option{'blocks'};

  if (exists $option{'link'} and $data{'type'} eq 'l') {
    $data{'link'} = readlink $_;
  }

  if (exists $option{'md5'} and -f _) {
    $md5->reset;
    open FILE, $_ or warn "Problem opening $_ for md5: $!\n";
    binmode FILE;
    $data{'md5'} = $md5->addfile(*FILE)->hexdigest;
    close FILE;
  }

  for (@option) {
    print $data{$_} if exists $data{$_};
    print "\t" unless $option[$#option] eq $_;
  }
  print "\n";

  # prune out dirs if required
  # TODO: ability to record in output where this happens?
  if (defined $prune and -d _) {

    my $result = eval "return 1 if (" . $prune . ");";

    if ($@) {
      chomp $@;
      die "Error: prune eval failure: ", $@;  # croak on errors
    }

    if ($result) {
      $File::Find::prune = 1;
      warn "Pruned: ", $_, "\n" unless $quiet;
      return;
    }
  }
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [opts] [files]

Records the state of files.

Options for version $VERSION:
  -h/-?  Display this message

  -q     Quiet; less output.

  -o nn  Include options nn as ouput columns.

  -X     Do not cross file system boundaries.

  -s xx  Perl expression to skip files.
  -p xx  Perl expression to prune directories from search.

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

fs-snapshot.pl - records the state of files

=head1 SYNOPSIS

  $ fs-snapshot.pl /usr/local > /tmp/snapshot

=head1 DESCRIPTION

=head2 Overview

Script to record state of file system.  Records filename and path,
along with various file metadata in tab separated format to standard
output.  Options exist to limit or exclude portions of the filesystem
from scanning.

See fs-compare.pl for a utility to review multiple snapshots for
differences.

=head2 Normal Usage

  $ fs-snapshot.pl [options] [files]

See L<"OPTIONS"> for details on the command line switches supported.

The script will attempt to read file names from standard input if
none are specified on the command line.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

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

Prints a brief usage note about the script.

=item B<-q>

Make the script less chatty.

=item B<-o> I<options>

Allows one to customize the data present in the output.  Takes a list
of comma or space separated values.  Lowercase names are reserved for
actual option names.  Uppercase names are reserved for expansions to
enable common groups of options:

  -o D,md5

See the source code to see what option names actually do anything.

=item B<-X>

Prevents script from crossing file system boundaries.

=item B<-s> I<expression>

Perl expression that will result in the current item (stored in $_)
being skipped if the expression turns out to be true.  Example:

  -s '-d or m/^\.rsrc$/'

Would skip applying the changes to any directories or files named
'.rsrc'. B<Warning>: skip only removes the matched files from output. 
Subfiles would still be reported on in the case of a skipped
directory.

=item B<-p> I<expression>

Perl expression that will result in the current directory (stored in
$_) and anything below that directory being "pruned" from the search.

For example, one can easily prune out all directories lower than the
one supplied as an argument by using the special $parent variable to
check against the current directory; essentially, this turns off the
default recursive behaviour of L<File::Find|File::Find>:

  -p '$parent ne $_'

=back

=head1 EXAMPLES

None yet.

=head1 ENVIRONMENT

Relies heavily on lstat() and similar unix file information.  Will
need adjustment to take into account additional or different
filesystems.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2002, Jeremy Mates.  This script is free software;
you can redistribute it and/or modify it under the same terms as Perl
itself.

=head1 VERSION

  $Id: fs-snapshot.pl,v 1.22 2003/01/13 05:28:43 jmates Exp $

=cut