#!/usr/bin/perl -w
#
# $Id: revertgrp.pl,v 1.9 2001/07/25 00:13:01 jmates Exp $
#
# Copyright (c) 2000-2001, Jeremy A. 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 Getopt::Std;                # command line option processing

use File::Find;			# recursive directory walking

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

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

my (%opts, $verbose, %u2g, %n2u, %groups);

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

# parse command-line options
getopts('h?vp:s:g', \%opts);

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

$verbose = 1 if exists $opts{'v'};

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

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

# build a lookup table of user -> default group from passwd file
while (my ($user, undef, $uid, $gid) = getpwent()) {
    $u2g{$uid} = $gid;

    # and a hash for converting group members to uid's
    $n2u{$user} = $uid;
}

# if needed, add user's membership in other groups to the list
if (exists $opts{'g'}) {
    while (my (undef, undef, $gid, $members) = getgrent()) {
	# need convert space delimited list to uid's...
	for (split ' ', $members) {
	    my $uid = $n2u{$_};

	    # make a hash of hashes so we can use quick lookups
	    # instead of looping over an array for each file
	    $groups{$uid}->{$gid} = 1 if defined $uid;
	}
    }
}

# loop over the remaining input, looking for dirs and parsing them
for (@ARGV) {
    unless (-d $_) {
        warn "error: $_ not a directory, skipping\n";
        next;
    }

    find(\&do_stuff, $_);
}

# SUBROUTINES

sub do_stuff {
    # get current user/group ids off of file
    my ($uid, $gid) = (lstat)[4,5];

    # see if we should "prune" this directory
    if (exists $opts{'p'} && -d _) {
        my $results = eval "return 1 if( " . $opts{'p'} . " );";

        if ($@) {
            chomp $@;
            die "Prune error: ", $@; # croak on errors
        }

        if ($results) {
            $File::Find::prune = 1;
            return;
        }
    }

    # (try to) figure out what to skip
    if (exists $opts{'s'}) {
        my $result = eval "return 1 if( " . $opts{'s'} . " );";

        if ($@) {
            chomp $@;
            die "Skip error: ", $@; # croak on errors
        }

        if ($result) {
            return;
        }
    }

    # catch odd 'uninitialized value' errors I'm seeing (DBG)
    if ($verbose) {
	warn $File::Find::name, ' uid ', $uid, ' gid ', $gid, " uninitialized\n" unless defined $u2g{$uid};
    }

    # see whether gid of this file exists in our lookup hash
    if ($gid != $u2g{$uid}) {
	# and optionally whether other group is valid for the user
	if (exists $opts{'g'}) {
	    return if exists $groups{$uid}->{$gid};
	}
	print $File::Find::name, ' ', $gid, ' to ', $u2g{$uid}, "\n" if $verbose;
	
	my $result = chown $uid, $u2g{$uid}, $_;
	warn "error: chown on ", $File::Find::name, " failed\n" if $result == 0;
    }
}

sub help {
    print <<"HELP";
Usage: $0 [options] dir1 dir2 .. dirN

Recursive group ownership fixing utility.

Options for version $VERSION:
  -h/-?  Display this message
  -v     Show files group was changed on, and previous and new gid settings.

  -g     Do not change group to default group if user belongs to the non-
         default group the file is set to.

  -s xx  Perl expression that will result in the current item (stored in \$_)
         being skipped if the expression turns out to be "true."

  -p xx  Perl expression that will result in the current directory (stored in 
	 \$_) being pruned out of the tree.

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

HELP
    exit;
}

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

=head1 NAME

revertgrp.pl - recursive group ownership fixing utility.

=head1 SYNOPSIS

Fix group settings on a bunch of files under /home/user/restore:

  $ revertgrp.pl /home/user/restore

=head1 DESCRIPTION

=head2 Overview

A recursive group fixer that parses a directory tree, correcting the
group on each file to the default group of the owner.

=head2 Normal Usage

  $ revertgrp.pl [options] [dir1 dir2 .. dirN]

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

Any number of directories can be supplied, including none.  In that
case, the script will attempt to read directories from STDIN.

=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<-v>

Show files group was changed on, and previous and new gid settings.

=item B<-g>

Skip changing group if user belongs to this non-default group on the
file in question.

=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 || m/^\.rsrc$/'

Would skip applying the changes to any directories or items named
'.rsrc'. B<Warning>: skip only counts towards whether or not any
actions are performed; modefix.pl will happily apply changes below 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 File::Find:

  -p '$parent ne $_'

=back

Note: Expressions should use the shortcut _ operator in any stat()
calls, to avoid race conditions.  See the entry for stat under
perlfunc(1) for the gory details.

=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 A. Mates, http://sial.org/contact/

=head1 COPYRIGHT

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

=head1 VERSION

  $Id: revertgrp.pl,v 1.9 2001/07/25 00:13:01 jmates Exp $

=cut