File::Find::Rule::Permissions - rule to match on file permissions and user

  use File::Find::Rule::Permissions;

  # Which files can the 'nobody' user read in the current directory?
  @readable = File::Find::Rule::Permissions->file()
      ->permissions(isReadable => 1, user => 'nobody')
      ->in('.');

  # Which files can UID 42 *not* read in the current directory?
  @notreadable = File::Find::Rule::Permissions->file()
      ->permissions(isReadable => 0, user => 42)
      ->in('.');

  # Find big insecurity badness!
  @eek = File::Find::Rule::Permissions->permissions(
      isWriteable => 1,
      isExecutable => 1,
      user => 'nobody'
  )->in('/web');

  File::Find::Rule

package File::Find::Rule::Permissions;
use strict;

use Devel::AssertOS::Unix;

use File::Find::Rule;
use base qw(File::Find::Rule);
use vars qw(
    $VERSION @EXPORT
    %UIDsByUsername %UsernamesByUID %GIDsByGroupname
    %GroupnamesByGID %UIDinGID
);
@EXPORT  = @File::Find::Rule::EXPORT;
$VERSION = '2.0';

use Fcntl qw(:mode);

# figure out who has what UID and which UIDs are in which group
(%UIDsByUsername, %UsernamesByUID, %GIDsByGroupname,
    %GroupnamesByGID, %UIDinGID) = ();
getusergroupdetails();

# we override these in the test suite to avoid having to be root.
# or we will do when that bit is written, anyway.

sub stat { return CORE::stat(@_); }
sub geteuid { return $>; }
sub getusergroupdetails {
    while(my($name, undef, $uid, $gid) = getpwent()) {
        $UIDsByUsername{$name} = $uid;
        $UsernamesByUID{$uid} = $name;
        $UIDinGID{$gid}{$uid} = 1;
    }
    while(my($grname, $grpass, $gid, $members) = getgrent()) {
        $GIDsByGroupname{$grname} = $gid;
        $GroupnamesByGID{$gid} = $grname;
    
        foreach my $member (split(/\s+/, $members)) {
            next unless(exists($UIDsByUsername{$member}));
            $UIDinGID{$gid}{$UIDsByUsername{$member}} = 1;
        }
    }
}

sub File::Find::Rule::permissions {
    my $self = shift()->_force_object;
    my %criteria = UNIVERSAL::isa($_[0], "HASH") ? %{$_[0]} : @_;

    $self->exec(sub {
        my $file = shift;
        my $userid;
        
        # first check that we've got the mandatory parameters
        if(
            !exists($criteria{isReadable}) &&
            !exists($criteria{isWriteable}) &&
            !exists($criteria{isExecutable})
        ) { die("File::Find::Rule::Permissions::permissions: no criteria\n"); }
        
        # if a user has been specified, first get their UID (from their
	# username if necessary).  If a user *hasn't* been specified,
	# then we pretend one has anyway
        $criteria{user} = geteuid() unless(exists($criteria{user}));
        if($criteria{user} =~ /^\d+$/) { $userid = $criteria{user}; }
         else { $userid = $UIDsByUsername{$criteria{user}}; }
            
        # now divine the user's permissions.  first get the file's mode
	# bits and ownership
        my($mode, $file_uid, $file_gid) = (&stat($file))[2,4,5];
        
        # now check user/group perms.  Set isReadable etc if the mode has
	# the owner bit set and the user is the owner, or has the group bit
	# set and the user is in the right group
        my $isReadable = $mode & (
            (($userid == $file_uid) ? S_IRUSR : 0) |
            ($UIDinGID{$file_gid}{$userid} ? S_IRGRP : 0)
        );
        my $isWriteable = $mode & (
            (($userid == $file_uid) ? S_IWUSR : 0) |
            ($UIDinGID{$file_gid}{$userid} ? S_IWGRP : 0)
        );
        my $isExecutable = $mode & (
            (($userid == $file_uid) ? S_IXUSR : 0) |
            ($UIDinGID{$file_gid}{$userid} ? S_IXGRP : 0)
        );
	# now check "other" perms.  Set isReadable etc if "other" bit is
	# set and user is *not* owner and *not* in right group
	if($userid != $file_uid && !$UIDinGID{$file_gid}{$userid}) {
	    $isReadable = $mode & S_IROTH;
	    $isWriteable = $mode & S_IWOTH;
    	    $isExecutable = $mode & S_IXOTH;
	}

        # root can read and write anything, can execute anything
        # with any x bit set
        $isReadable = $isWriteable = 1 if($userid == 0);
        $isExecutable = 1 if($userid == 0 && $mode & 0111);
        
        # Why do all those constants look like incantations to the elder gods?
        #
        # S'IXOTH, S'IXOTH IRGRP!
        
        if(exists($criteria{isReadable}) && $criteria{isReadable}) {    # must be readable
            return 0 unless($isReadable);
        } elsif(exists($criteria{isReadable}) && !$criteria{isReadable}) { # must not be ...
            return 0 if($isReadable);
        }
        if(exists($criteria{isWriteable}) && $criteria{isWriteable}) {  # must be writeable
            return 0 unless($isWriteable);
        } elsif(exists($criteria{isWriteable}) && !$criteria{isWriteable}) {
            return 0 if($isWriteable);
        }
        if(exists($criteria{isExecutable}) && $criteria{isExecutable}) {# must be executable
            return 0 unless($isExecutable);
        } elsif(exists($criteria{isExecutable}) && !$criteria{isExecutable}) {
            return 0 if($isExecutable);
        }
        
        return 1;
    } );
}

1;