Handy logrotate.d verification script (in Perl)

This is a Perl script I wrote a while back as a housekeeping tool for Linux systems. It looks in /var/log and in /etc/logrotate.d, comparing the existing log files to the ones mentioned in your logrotate configuration files, producing a helpful list of which files are not being rotated.

If you've ever had a box die on you because an unrotated log ate up
all your disk space, then you'll find this script a useful preventative.

This is totally public domain. It's a stupid tiny thing, I'm not even going to bother to GPL it.

Here's the source, I've also attached it as a file for ease of downloading.

#!/usr/bin/perl
#
# Script to facilitate logrotate script updates
# by DG 22-Sep-2002
#
# This script scans /etc/logrotate.d and
# /var/log looking for any log files that
# don't have a corresponding logrotate
# configuration script. It then lists out
# the name part (everything to the left
# of the first '.') of logs for which
# logrotate scripts are needed.
#
#
# History/Changelog:
#
# 0.4 - 08-Jan-2005 trying to add subdir scanning support
# 0.3 - 03-Sep-2003 Keep /var/log subdirs out of report
# 0.2 - 22-Sep-2002 Scan /etc/logrotate.conf as well
# 0.1 - 22-Sep-2002 original working release
#

my $VERSION = "0.4";
#
# read_directory() returns all files found in $directory.
# It's recursive, but results do NOT include the traveresed
# directories themselves.
#
sub read_directory {
	my $directory = $_[0];
#	print "$directory\n\n";
	opendir DIR, $directory or die "Cannot open Directory $directory!\n";
        my @files2 = ();
	my @files = readdir DIR;
	for (@files) {
		if (-d "$directory/$_") {
		    next if $_ eq "." or $_ eq "..";
		    push @files2, &read_directory("$directory/$_");
		    print "$directory/$_\n";
		}
		else {
		    push @files2, ("$directory/$_");
		}
	}
	closedir DIR;
	return @files2;
}
my %lshash = { };
sub found_in_hash {
    my $subj = $_[0];
    use vars qw(%lshash);
    # Do trivial case fast
    if ($lshash{$subj} eq '1') { return 1; }
    my @ka = keys %lshash;
    foreach $k (@ka) {
#        print "DEBUG: comparing '$subj$' to '$k'\n" if ($k =~ m/tomcat/);
#        print "DEBUG: comparing '$subj$' to '$k'\n";
	if ($subj =~ m/$k/) { return 1; }
    }
    return 0;
}
### MAIN STARTS HERE ###
my $lrdir = '/etc/logrotate.d';
my $logdir = '/var/log'; 
my $logconf = '/etc/logrotate.conf';
print "\nlrcheck v$VERSION (c) 2002 Origami Partners\n\n";
print "Scanning $lrdir...\n";
opendir LRD, $lrdir or die "Unable to open logrotate script directory $lrdir!\n";
my @lrscripts = readdir LRD;
closedir LRD;
push @lrscripts, $logconf;	# v0.2: main conf file can have logrotate scripts in it!
print "Scanning $logdir...\n";
#opendir LOGD, $logdir or die "Unable to open log directory $logdir!\n";
my @logfiles = read_directory($logdir);
my @lognames = ();
my @lfrefs = ();		# log file references in logrotate scripts
my %sizehash = { };
# Read each logrotate script and extract logfile names
foreach $lscript (@lrscripts) {
    if ($lscript =~ m:^/:) {	# filespec starts with / => absolute path
        open LRS, "$lscript" or die "Unable to open logrotate script $lscript!\n";
    }
    else {
        # filespec is relative path -- assume it's in $lrdir
        open LRS, "$lrdir/$lscript" or die "Unable to open logrotate script $lrdir/$lscript!\n";
    }
    while () {
	# NOTE: assuming all logfile references in scripts are absolute
	if (/$logdir/) {
	    my @tokens = split;	# default split on whitespace, split $_
	    foreach $tok (@tokens) {
	        if ($tok =~ m:($logdir)\/(\S+):) { push @lfrefs, "$logdir\/$2"; }
	    }
	}
    }
    close LRS;
}
my @fparts = ();		# work var for split() calls
my @lfrefs2 = ();
# lose everything to the right of first '.'
foreach $logref (@lfrefs) {
	@fparts = split /\./, $logref;
#	if ($fparts[0] =~ m:/:) {
#		printf "lrcheck: warning: '$fparts[0]': log subdirectory not supported\n";
#	}
#        else {
		push @lfrefs2, $fparts[0];
#	}
}
# Now create the hash so we know which logs have scripts
foreach $logref (@lfrefs2) {
    $logref =~ s/\*/\.\*/g;         # convert dir-style wildcard to regexp wildcard 
    $logref =~ s/(log|txt|out)$//x;     # remove extension ref from end of string
    $lshash{$logref} = 1;
}
# Store log filesize for later, and
# lose everything to the right of first '.'
foreach $logf (@logfiles) {
    next if ($logf =~ m/\.gz/);
    next if ($logf =~ m/\.bz2/);
    ($dum,$dum,$mode,$dum,$dum,$dum,$dum,$size,$dum,$dum,$dum,$dum,$dum) = stat "$logf";
#    print "DEBUG: file $logf: mode = '$mode'\n";
    if (!($mode =~ m/^16/)) {
	    # not a log subdir, so add to hash
	    @fparts = split /\./, $logf; push @lognames, $fparts[0];
	    $sizehash{$fparts[0]} = $size;
    }
}
# Now eliminate duplicates
@lognames = sort @lognames;
my @loguniq = ();
my $lastlogn = '';
foreach $logn (@lognames) { if ($logn ne $lastlogn) { push @loguniq, $logn; } $lastlogn = $logn; }
@lognames = @loguniq;	# Now contains unique sorted list
# OK, now report cross-scan against our logrotate scripts
# print "Found these log base names:\n";
my $gotOne = '';		# MUST declare BEFORE reference in format string below 
my $lgSize = '';		# MUST declare BEFORE reference in format string below
my $logprob = ' ';	# MUST declare BEFORE reference in format string below
print "\n";
format logrep_top =
                                         logrotate   logfile
Log name                                 script?       size        Problem?
--------------------------------------   ---------   -------       ------------
.
format logrep =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<      @>>>>>>       @<<<<<<<<<<<<
$logn,                                   $gotOne,    $lgSize,      $logprob
.
my $dum = select(STDOUT); $^ = 'logrep_top'; $~ = 'logrep'; select($dum);
foreach $logn (@lognames) {
	$logprob = 'OK';
#	if ($lshash{$logn} eq '1')
        if (found_in_hash($logn))
        { $gotOne = 'OK'; }
        else {
            { $gotOne = '  '; $logprob = 'Not rotated'; }
	    if (defined $sizehash{$logn}) {
	        $lgSize = $sizehash{$logn};
	        if ($lgSize eq 0) { $logprob = '(empty)'; }
	    } else { $lgSize = '--'; } 
	    write;
	}
}
print "\n";