ugid-scan

#!/usr/bin/perl
# Scan filesystem and build a database index of which directories contain
# files and directories with what numeric uid and gid.
#
# Certain uid and gid ranges can be excluded from the index, such that
# the index only records files with uid/gid values that need attention.
#
# Markus Kuhn

use strict;
use File::Find ();
use POSIX qw(strftime);
use Storable;
use FindBin qw($RealBin);     # find directory where this file is located ...
use lib $RealBin;             # ... and add it to @INC ...
use UGidScan;                 # so we can load this

# hash (key=uid or gid) of hash (key=directory path) indexing all
# files found with interesting uid or gid
our %uid;
our %gid;

# command-line parameters
#
our $excluded_uids;
our $excluded_gids;
our $verbose = 0;
our $report_frequency = 10;   # log entry every that many seconds
our $logfilename;
our $ufilename;
our $dbfn = "$RealBin/ugid-list.sdb";
our @roots;
our $normalize_old;
our $normalize_new;

our @usage;
$usage[1] = <<"EOT";
Build a database index to search for files based on numeric uid and/or gid.

Usage: $0 [options] path ...

Options:

  -f <filename>    Set filename of database/index output file
                   (default: '$dbfn')

  -l <filename>    Set logfile name

  -r <int>         Add a logfile entry every <int> seconds

  -u <range>       UID ranges to be excluded from the index

  -g <range>       GID ranges to be excluded from the index

  -n <old> <new>   replace substring <old> in a pathname with substring <new>
                   before recording it in the index

  -U <filename>    Record unusual filenames (write list of \0-terminated paths)

  -v               Increase verbosity level

  -h               Print this help message

EOT
$usage[2] = <<"EOT";
Example:

\$ $0 -f ugid-list.sdb \
        -u 1100-3600,0-1,3611-9499 \
        -g 1100-3600,0-1,3611-10000,19-20 \
        -n '/.snapshot/sv_daily.0' '' \
        /Nfs/Mounts/elmer-vol{1,3,4,5,6,8}/.snapshot/sv_daily.0 \
        /Nfs/Mounts/elmer-vol{7,9}
EOT
$usage[3] = <<"EOT";

Preferably run

  - on an NFSv3 client, as NFSv4 translates uids and gids
    (e.g. with Linux autofs mount option "nfsvers=3" in /etc/default/autofs)

  - as user "root" on NFS exports without root squash

  - on snapshot directories, to prevent atime updates

EOT

sub usage {
    print STDERR @usage;
    exit 0;
}

our @command = ($0, @ARGV);
while ($ARGV[0] =~ /^-/) {
    $_ = shift @ARGV;
    if ($_ eq '-f') {
	$dbfn = shift @ARGV;
    } elsif ($_ eq '-l') {
	$logfilename = shift @ARGV;
    } elsif ($_ eq '-U') {
	$ufilename = shift @ARGV;
    } elsif ($_ eq '-r') {
	$report_frequency = shift @ARGV;
    } elsif ($_ eq '-u') {
	$excluded_uids = shift @ARGV;
    } elsif ($_ eq '-g') {
	$excluded_gids = shift @ARGV;
    } elsif ($_ eq '-n') {
	$normalize_old = shift @ARGV;
	$normalize_new = shift @ARGV;
    } elsif ($_ eq '-v') {
	$verbose++;
    } elsif ($_ eq '-h' || $_ eq '--help') {
	usage();
    } else {
	die("Unknown option '$_', use option -h for help.\n");
    }
}

@roots = @ARGV;
usage() unless @roots;

our $excluded_uids_filter = Filter->new($excluded_uids);
our $excluded_gids_filter = Filter->new($excluded_gids);

our $report = 0;
our $logfile;
our $ufile;
our $timestart = time;

# this subroutine visits every file found
sub wanted {
    # skip stale NFS file handles
    return if /^\.nfs[0-9a-f]{24}\z/;

    # output progress report requested by SIGALRM
    if ($report) {
	$report = 0;
	my $elapsed = time - $timestart;
	print($logfile
	      sprintf('%3d:%02d:%02d',
		      $elapsed / 3600, ($elapsed % 3600) / 60, $elapsed % 60),
	      ' ',
	      strftime('%Y-%m-%d %H:%M' .
	               ($report_frequency < 60 ? ':%S' : ''), localtime),
	      ' ', $File::Find::name, "\n");
	alarm $report_frequency;
    }

    my (undef,undef,undef,undef,$uid,$gid) = lstat;

    return unless defined $gid;

    # don't recurse into NetApp backups
    if (-d _ && $_ eq '.snapshot') {
        $File::Find::prune = 1;
        return;
    }

    # normalize directory name
    my $ndn = $File::Find::dir;
    my $p;
    if (defined $normalize_old &&
	($p = index($ndn, $normalize_old)) >= 0) {
	substr($ndn, $p, length($normalize_old)) = $normalize_new;
    }

    # record files with notable uid
    unless (defined $excluded_uids && $excluded_uids_filter->matches($uid)) {
	# skip files owned by root or daemon (too many)
	print "u$uid:$ndn\n"
	    if $verbose && !$uid{$uid}{$ndn};
	$uid{$uid}{$ndn}++;
    }
    # record files with notable gid
    unless (defined $excluded_gids && $excluded_gids_filter->matches($gid)) {
	print "g$gid:$ndn\n"
	    if $verbose && !$gid{$gid}{$ndn};
	$gid{$gid}{$ndn}++;
    }

    # output paths of unusual filenames
    if (defined $ufile && !/^[ -~]+\z/) {
        print $ufile $ndn;
        print $ufile "/" unless $ndn =~ /\/\z/;
        print $ufile $_, "\0";
    }
}

# as this is a long-running process, output progress reports
if ($logfilename) {
    $SIG{ALRM} = sub { $report = 1; };
    open($logfile, '>', $logfilename)
	|| die("Cannot write log file '$logfilename': $!\n");
    $logfile->autoflush(1);
    alarm $report_frequency;
}
if ($ufilename) {
    # file for recording unusual filenames encountered
    open($ufile, '>', $ufilename)
	|| die("Cannot write log file '$ufilename': $!\n");
}

# Traverse desired filesystems
File::Find::find({ wanted => \&wanted }, @roots);
our $timeend = time;

close $logfile if $logfilename;
close $ufile if $ufilename;

# convert hash of hashes data into a more compact hash of arrays
my $db = UGidScan->read_hash_list(\%uid, \%gid);

# also record some metadata about the scan in $db
$db->{'command'} = [ @command ];
$db->{'euid'} = $>;
$db->{'egid'} = $);
$db->{'hostname'} = `/bin/hostname`;
chomp $db->{'hostname'};
for my $root (@roots) { -e "$root/"; }  # trigger automounts
$db->{'mounts'} = `findmnt -t nfs,nfs4`;
$db->{'ps'} = `ps u --pid $$`;
$db->{'excluded_uids'} = $excluded_uids;
$db->{'excluded_gids'} = $excluded_gids;
$db->{'time'} = [ $timestart, $timeend ];

# write index file by serializing $db data structure
my $fntmp = "$dbfn~";
store $db, $fntmp;
rename $fntmp, $dbfn;