UNIX Desktop Questions & Answers

#!/usr/bin/perl
#
#
# Run the program with an argument of the directory you want to completely scan
# Usage:
# perl check.pl /usr/bin
#
# By default it will perform check for the root "/"
# This program reports SUID, SGID, STICKY, writeable files by
# user who shouldn't be editing a lot of your files.  :)
# It prints everything to STDOUT by default.  Redirect the output wherever you want.

use warnings; # keep me informed
use strict;  # Keep me honest

my $root = shift;
my $BEGINNING_LEVEL=0;

if(not $root)
{
    # Initialize if the user didn't give us anything to cling to.
    $root="/";
}

# Level indexing is provided for debugging and to check if it's going out
# of control.  In dirinfo() you can adjust what the warning and error levels
# are for the number of directory levels deep this will check.
print "Calling dirinfo\n";
dirinfo($root, $BEGINNING_LEVEL);

sub dirinfo
{
    my $dirname = shift;
    my $level = shift;
    my $HANDLE;
    my $MAXLEVEL=100;
    my $WARNINGLEVEL=50;

    if($level==$WARNINGLEVEL)
    {
        print STDERR "WARNING: Deep directory structure. I hope you have some serious RAM free...\n";
    }
    if($level>$MAXLEVEL)
    {
        print STDERR "ERROR: Max recursion met - directory structure deeper than $MAXLEVEL directories. You can change the default in the script, or you can see if you can find any circular symlinks that are causing the problem.  Check the end of your output for clues.\n\n";
        die "ERROR:  Max-eval-depth error.\n";
    }

    opendir HANDLE, "$dirname" or return(-1);

    my @allfiles = readdir HANDLE;

#    print  "Reading info on \"$dirname\"...\n";

    TORTURE: foreach my $file (@allfiles)
    {
        my $foobar;

        if($dirname eq "/")
        {
            $foobar = $dirname . $file;
        }
        else
        {
            $foobar = $dirname. "/". $file;
        }

        # print "\"$foobar\" level $level\n";
        if(($file eq ".") or ($file eq ".."))
        {

        }

        # If the file is writeable, and doesn't belong to the user running
        # this script, then it gets reported.
        elsif((-W $foobar) and (not (-O $foobar)))  # File is writeable&&!owned
        {
            # If it's a directory, report it as such.
            if(-d $foobar)  # File is a directory
            {
                print "\"$foobar\" ### WRITEABLE FOLDER\n"
            }
            else
            {
                my $fileinfo=`ls -la "$foobar"`;
                chomp($fileinfo);
                print "\"$fileinfo\" ### WRITEABLE\n";
            } # End else
        } # End elsif
        elsif(-l $foobar)
        {
            # my $fileinfo=`ls -l "$foobar"`;
            # chomp($fileinfo);
            # print "\"$fileinfo\" ### SYMLINK\n";
            # Symlink evilness.  Especially with GNOME.  :(
        }
        elsif(-d $foobar)  # File is a directory
        {
            # File is a directory - recurse through it
            # DEBUG: print "Entering \"$file\" coming from \"$dirname\"\n";
            my $tmp=dirinfo($foobar, ($level+1));
            if($tmp == -1)
            {
                print "Directory $foobar not readable with your user, sorry, wrong UID.\n";
            }
        }
        elsif(-u $foobar)   # File is SUID
        {
            my $fileinfo=`ls -la "$foobar"`;
            chomp($fileinfo);
            print "$fileinfo ### SUID\n";
        }
        elsif(-g $foobar)  # File is SGID
        {
            my $fileinfo=`ls -la "$foobar"`;
            chomp($fileinfo);
            print "$fileinfo ### SGID\n";
        }
        elsif(-k $foobar)  # File is sticky
        {
            my $fileinfo=`ls -la "$foobar"`;
            chomp($fileinfo);
            print "$fileinfo ### STICKY\n";
        }
        else
        {
#           DEBUG2: print "\"$foobar\" doesn't look very interesting to me.\n";
        }
    } # End foreach
} # End dirinfo

#end