#!/usr/bin/perl -w

# filesanity-tagger:  this eats output of find -print0 and looks for
# "interesting" files.  your definition of interesting may differ.  generally
# you want to diff the output of this program from one day to the next -- to
# see what's changing.

# Copyright (c) 2006 dean gaudet <dean@arctic.org>
# 
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

# much of this stolen from "find2perl -ls"

# $Id: filesanity-tagger,v 1.7 2006/09/13 06:05:41 dean Exp $

use strict;
use Fcntl ':mode';

my @rwx = qw(--- --x -w- -wx r-- r-x rw- rwx);
my @moname = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

my (%uid, %user);
while (my ($name, $pw, $uid) = getpwent) {
    $user{$uid} = $name unless exists $user{$uid};
}

my (%gid, %group);
while (my ($name, $pw, $gid) = getgrent) {
    $group{$gid} = $name unless exists $group{$gid};
}

sub sizemm {
    my $rdev = shift;
    sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
}

sub ls ($) {
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
    my $pname = $_;

    $blocks
        or $blocks = int(($size + 1023) / 1024);

    my $perms = $rwx[$mode & 7];
    $mode >>= 3;
    $perms = $rwx[$mode & 7] . $perms;
    $mode >>= 3;
    $perms = $rwx[$mode & 7] . $perms;
    substr($perms, 2, 1) =~ tr/-x/Ss/ if -u _;
    substr($perms, 5, 1) =~ tr/-x/Ss/ if -g _;
    substr($perms, 8, 1) =~ tr/-x/Tt/ if -k _;
    if    (-f _) { $perms = '-' . $perms; }
    elsif (-d _) { $perms = 'd' . $perms; }
    elsif (-l _) { $perms = 'l' . $perms; $pname .= ' -> ' . readlink($_); }
    elsif (-c _) { $perms = 'c' . $perms; $size = sizemm($rdev); }
    elsif (-b _) { $perms = 'b' . $perms; $size = sizemm($rdev); }
    elsif (-p _) { $perms = 'p' . $perms; }
    elsif (-S _) { $perms = 's' . $perms; }
    else         { $perms = '?' . $perms; }

    my $user = $user{$uid} || $uid;
    my $group = $group{$gid} || $gid;

    my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime);
# i don't like the way this varies the date string causing spurious diffs
#    if (-M _ > 365.25 / 2) {
#        $timeyear += 1900;
#    } else {
#        $timeyear = sprintf("%02d:%02d", $hour, $min);
#    }

    printf "%6lu %4ld %-10s %3d %-8s %-8s %8s %s %2d %02d:%02d %4s %s\n",
            $ino,
                 $blocks,
                      $perms,
                            $nlink,
                                $user,
                                     $group,
                                          $size,
                                              $moname[$mon],
                                                 $mday,
                                                     $hour,
						          $min,
							       $timeyear + 1900,
                                                                   $pname;
    1;
}



$/ = "\0";
while (<>) {
	chomp;
	if (my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat) {

		# everything should below to an existing group/user
		defined($user{$uid}) or print "bad-uid $uid $_\n";
		defined($group{$gid}) or print "bad-gid $gid $_\n";

		# dangling and cross-device symlinks
		if (S_ISLNK($mode)) {
			my $target = readlink($_);
			if (!defined($target)) {
				warn "readlink($_) error: $!\n";
			}
			elsif (!stat) {
				print "dangling $_ -> $target\n";
			}
			elsif ($dev != (stat)[0]) {
				print "xdev $_ -> $target\n";
			}
		}

		# display any setuid/gid file
		if (S_ISREG($mode) and ($mode & 06000)) {
			print "suid "; ls($_);
		}

		# misplaced devices
		if ((S_ISCHR($mode) or S_ISBLK($mode)) and !m#^/dev/#) {
			print "misplaced-dev "; ls($_);
		}

		# fifos -- excluding ones which change regularly
		if (S_ISFIFO($mode)
			and $_ ne '/var/qmail/queue/lock/trigger'
			and !m#^/var/run/screen/#) {
			print "fifo "; ls($_);
		}

		# sockets -- excluding ones which change regularly
		if (S_ISSOCK($mode)
			and !m#^/tmp/ssh-\S{10}/agent\.\d+$#) {
			print "socket "; ls($_);
		}

		# look for sparse files
		if (S_ISREG($mode) and $size > $blksize * $blocks) {
			print "sparse "; ls($_);
		}
	}
	elsif ($! ne 'No such file or directory') {
		warn "lstat($_) error: $!\n";
	}
}