cricket 1.0.5-21 / usr / share / cricket / collect-subtrees

#!/usr/bin/perl -w
# -*- perl -*-

# Cricket: a configuration, polling and data display wrapper for RRD files
#
#    Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# This is a smart wrapper for collector.
# It understands the concept of "subtree sets". It takes one
# argument, the subtree set it will process. It rolls the logfiles
# for that set, then runs the collector on that subtree set.

# it reads its subtree sets from a config file, by default a file
# in the cricket install directory named 'subtree-sets'. You can
# and should put the file somewhere else, and use the -cf argument
# to tell collect-subtrees where to find it.

BEGIN {
    require '/etc/cricket/cricket-conf.pl';
}

$| = 1; # Useful if you want to tail -f a logfile while the collector runs! :)
use lib "$Common::global::gInstallRoot/lib";

use Getopt::Long;
use Common::global;
use strict;

my @mHist;
my $gMailTo;
my $gDebug = 0;
my $gCF = "/etc/cricket/subtree-sets";

GetOptions( "cf=s" => \$gCF,
            "mail|m=s" => \$gMailTo,
            "debug|d" => \$gDebug,
            );

my $gLogDir = $Common::global::gLogDir;
my $gBase = $Common::global::gConfigRoot;
my $gKeepLogs = 20;
my $gUser = getlogin || getpwuid($<);    # idiom from perlfunc manpage
my $gCurSet;
my $mOut = 0; $mOut = 1 if(defined($gMailTo));
my ($gSets, %gSets, @gSets);

# Change this to = 1 if you want to get collection length statistics.
my $subtreeTimes = 0;

# Change this to your local mailer if you don't have /usr/bin/mailx!
my $gMailer = '/usr/bin/mailx';

open(S, "<$gCF") ||
    die("Could not read $gCF file.\n");

while (<S>) {
    chomp;

    # nuke comments and blank lines
    s/^\s*#.*$//;
    next if (/^\s*$/);

    if (/^\s*set\s+(.*):/i) {
        $gCurSet = $1;
        next;
    } elsif (/^\s*base:\s+(.*)/i) {
        $gBase = $1;
        if ($gBase !~ m#^/#) {
            $gBase = "$Common::global::gCricketHome/$gBase";
        }
    } elsif (/^\s*logdir:\s+(.*)/i) {
        $gLogDir = $1;
        if ($gLogDir !~ m#^/#) {
            $gLogDir = "$Common::global::gCricketHome/$gLogDir";
        }
    } else {
        my($subtree) = $_;
        $subtree =~ s/^\s*//;
        if (! defined($gCurSet)) {
            warn("No set lines found. Ignoring subtree $subtree.\n");
        } else {
            push @{$gSets{$gCurSet}}, $subtree;
        }
    }
}
close(S);

# if none specified, do them all
if ($#ARGV == -1) {
    @ARGV = sort(keys(%gSets));
}

foreach my $s (@ARGV) {
    my($subtreeRef) = $gSets{$s};
    my(@output) = ();
    my($debugFlag) = "";
    if (! defined($subtreeRef) && $s ne 'ALL') {
        if($mOut == 1) {
            push @mHist, "$0: unknown subtree name: $s\n";
        } else {
            print STDERR "$0: unknown subtree name: $s\n";
        }
        next;
    }

    my($lockfile) = "/tmp/$gUser-subtree-$s";

    # file locking relies on touch, which is not available on Win32
    if (!isWin32()) {
        if (-f $lockfile) {
            if($mOut == 1) {
                push @mHist, "Subtree $s is currently being processed." .
                    " If this is a mistake,\n";
                push @mHist, "use \"rm $lockfile\" to unlock it.\n";
            } else {
                print STDERR "Subtree $s is currently being processed." .
                    " If this is a mistake,\n";
                print STDERR "use \"rm $lockfile\" to unlock it.\n";
            }
            next;
        }

        # lock it
        system("touch $lockfile");
    }

    #rollLogs($s);
    my $logfile = "$gLogDir/$s.log";
    my $timelogfile = "$gLogDir/$s.times";
    if(-f $timelogfile && -s $timelogfile >=  50000 && $subtreeTimes == 1) {
        rename $timelogfile, "$timelogfile.old";
    }

    $debugFlag = "-loglevel debug" if ($gDebug == 1);
    my $args = "$debugFlag -base $gBase ";
    $args .= join(" ", @{$subtreeRef})
      if ($s ne 'ALL');

    warn "$logfile: $!\n" unless open(LOG, ">>$logfile");

    my $collector = "$Common::global::gInstallRoot/collector $args";
    # Win32 does not support #! notation
    $collector = "perl $collector" if (isWin32());

    open(COLLECTOR, "$collector 2>&1|") || warn "collector: $!\n";

    (open(TL, ">>$timelogfile") || print STDERR "Couldn't open $timelogfile: $!") unless (!$subtreeTimes == 1);
    my $lastWasError;
    my $skipLine;
    
    my (@hist, @mHist) = ();
    
    while (<COLLECTOR>) {
        print LOG;

        # scan for errors and send them to stderr so that cron sends
        # them to the admin.

        # keep 5 lines of history
        push @hist, $_;
        shift @hist if ($#hist+1 > 5);

        # errors are marked with a * after the date:
        #     [21-Dec-1998 15:57:54*] RRD error ...

        if (/\*\] /) {
            if ($lastWasError) {
                if($mOut == 1) {
                    push @mHist, $_;
                } else {
                    print STDERR $_;
                }
            } else {
                if($mOut == 1) {
                    push @mHist, "\nError and the lines leading up to it:\n";
                    push @mHist, @hist;
                } else {
                    print STDERR "\nError and the lines leading up to it:\n";
                    print STDERR @hist;
                }
            }
            $lastWasError = 1;
        } else {
            if ($skipLine) {
                if($mOut == 1) {
                    push @mHist, "\n";
                } else {
                    print STDERR "\n";
                }
                $skipLine = 0;
            }
            $lastWasError = 0;
        }

    }
    close(COLLECTOR);

    # unlock it
    unlink($lockfile) if (!isWin32());

    if ($subtreeTimes == 1) {
        print TL $hist[$#hist];
        close(TL);
    }
    
    if(defined($mOut)) {
        mailHist($s, @mHist);
    }
}

sub rollLogs {
    my($logName) = @_;
    my($i) = $gKeepLogs;

    if (! -d $gLogDir ) {
        MkDir($gLogDir);
    }

    while ($i > 0) {
        rename("$gLogDir/$logName." . ($i-1), "$gLogDir/$logName." . $i);
        $i--;
    }
}

sub MkDir {
    my($dir) = @_;

    if (isWin32()) {
        my ($dd) = $dir;
        $dd =~ s/\//\\/g;
        `cmd /X /C mkdir $dd`;
    } else {
        system("/bin/mkdir -p $dir");
    }
}

sub isWin32 {
    return ($^O eq 'MSWin32');
}

sub mailHist {
    my ($subtree, @output) = @_;

    if($#output > 0) {
        my $subject = "output from subtree " . $subtree;

        open(MAIL, "|$gMailer -s \"$subject\" $gMailTo") ||
            die "Couldn't run $gMailer to send subtree output: $!\n";
        print MAIL @output;
        close(MAIL);
    }
}
exit 0;

# Local Variables:
# mode: perl
# indent-tabs-mode: nil
# tab-width: 4
# perl-indent-level: 4
# End: