#!/usr/bin/perl -w
#
# $Id: log_watcher.pl,v 1.1.1.1 2004/07/27 10:21:05 mpeppler Exp $

use strict;

# Steve Wechsler, smw@who.net
# written 6/98
# Last modified 1/99

# Updated by Michael Peppler (mpeppler@peppler.org) 
# handle dealock information printed to the log via the "print deadlock"
# config option.
# strict/warnings.

# Last modified 7/23/2002


# This script is designed to watch a continuously updating error log,
# parse it for certain keywords, and take actions based on those
# keywords.  It was intended for use with Sybase Adaptive Server,
# but should work with any type of log file that is continuously
# appended to, assuming you have written an appropriate control file.

# If you install this script, I'd appreciate an email letting me know.
# likewise if you make improvements.

# This script was inspired by the Swatch package by Todd Atkins (modified
# by Todd Boss for Sybase). If you've seen swatch you will notice a lot
# of similarities.  If you're interested in swatch, look for it here:
# http://www.bossconsulting.com/sybase_dba/sublevels/swatch.html

# I liked the way that package worked but was frustrated by the difficulty
# encountered when trying to debug, since swatch created a new perl script
# every time you ran it.  This script attempts to accomplish the same
# thing using just a config file.

# Config file format:

# offset: <column where error message starts>
# search_string<tab>action[<tab>action arguments[<tab>number of additional lines to read]]

# allowable actions are:

# mail beep ignore pipe exit
# However, pipe is not implemented.

# To install, you will need to make the following changes:

# 1: Make sure the first line of the script points to your installation of
#    perl
# 2: Change $MAIL_RECIPIENTS to point to whatever's appropriate for your site
# 3: If you have a paging system, make appropriate changes to sub beep
#    (if you don't, don't use the beep action)

# To run, I typically nohup it and redirect to /dev/null.  A good place
# to put it might be in your RUNserver file, as long as you set the
# exit action properly on "ueshutdown" (you'll have to kill it manually if
# you end up doing a "kill -9" on your server).

# The config file as written will work for Sybase 11.0.2.
# For other versions you will, at the least, need to change the offset.

# To do list:

# o Implement pipe subroutine
# o Convert to NT Perl

# One last note:
# When I wrote this script, I was not particularly well versed in Perl.
# I've learned a bit since then, and, looking through the script, there
# are a lot of things I would have done differently had I known better
# at the time.  However, given the limited time I've had to work on this
# lately, I figured it would be better to adopt the "if it ain't broke,
# don't fix it" attitude.  It works, and doesn't use a lot of CPU time,
# so I really haven't had much to complain about.

use vars qw($MAIL_RECIPIENTS $PAGING_GROUP $BIN_DIR);
use vars qw($CONFIG $INPUT $LOGFILE $SAVE_FILE $ERROR_TIMEOUT 
	    $CLEANUP_INTERVAL);


$MAIL_RECIPIENTS = 'mpeppler@kagi.com ty@kagi.com';
$PAGING_GROUP = "dba";
$BIN_DIR = "/sqldb/bin";

use Config;
use Getopt::Std;
use File::Basename;

select STDERR; $| = 1;
select STDOUT; $| = 1;

#$\ = "\n";

if (@ARGV < 2 || @ARGV > 3) {
    &usage;
    exit 1;
}

sub usage
{
    my $b = basename $0;
    print "Usage:\n";
    print "$b config_file input_file [log file]\n";
    exit 1;
}

($CONFIG, $INPUT, $LOGFILE) = @ARGV;
$LOGFILE = "&STDOUT" unless ($LOGFILE);

$SAVE_FILE = "save.$CONFIG";


$ERROR_TIMEOUT = 5 * 60;  # number of seconds before repeating an error 
# if you want to get all duplicate error messages, set $ERROR_TIMEOUT to 0
$CLEANUP_INTERVAL = 60 * 60; # delete old entries in hash every hour 

open CONFIG or die "Unable to open file $CONFIG - $!\n";

my $offset = 0;
my $i = 0;
my $line_no = 0;
my @string;
my @action;
my @actionargs;
my @numrows;

while (<CONFIG>) { 
    $line_no++;
    if (/^offset:/i) {
	my $junk;
        ($junk, $offset) = split /\s+/;
#       print "offset is $offset\n";
        next;
    }
    if ($_ !~ /^\#/ && $_ !~ /^\s+$/ && $_ !~ /^$/ ) {
        ($string[$i], $action[$i], $actionargs[$i],
         $numrows[$i]) = split /\t+/, $_;
	$numrows[$i] =~ s/\s//g;
        if ($string[$i] eq "" || $action[$i] eq "") {
            print @string;print @action;
            die "Invalid entry in $CONFIG at line $line_no\n";
        }
        $i++;
    }
}

close CONFIG;

my $last_cleanup_time = time;
open LOGFILE, ">>$LOGFILE" or die "Unable to open $LOGFILE for writing: $!\n";

select LOGFILE; $| = 1;

open INPUT or die "Unable to open input file $INPUT\n";

seek INPUT, 0, 2;
my $curpos = tell INPUT;
my $got_input = 0;
my %errtime;
my @block;
my $key;
my $got_error;

while (1) {
    while (<INPUT>) {
        if ($got_input == 1) {
#           print "Next line was $_";
            $got_input = 0;
        }
        $curpos = tell INPUT;
#       print "in INPUT loop\n";
# Delete old error messages so the hash table doesn't get too big...
        if ($last_cleanup_time + $CLEANUP_INTERVAL < time) {
            foreach $key (keys %errtime) {
                if ($errtime{$key} + $ERROR_TIMEOUT < time) {
#                   print "deleting time for $key\n";
                    delete $errtime{$key};
                }
            }
            $last_cleanup_time = time;
        }

# Parse the error log...

        for (my $str_index = 0; $str_index < @string; $str_index++) {
            if ($_ =~ /$string[$str_index]/i) {
                @block = ();
                push(@block, $_);
                $key = substr $_, $offset;
                if ($numrows[$str_index] && $numrows[$str_index] =~ /\S/) {
		    my $n = 0;
		    my $j = 1;
		    my $pat = '';
		    if($numrows[$str_index] =~ /^\d+$/ && 
		       $numrows[$str_index] > 0) 
		    {
			$n = $numrows[$str_index];
		    } else {
			chomp($pat = $numrows[$str_index]);
		    }
                    select undef, undef, undef, 0.5; # wait a half second
		    if($n) {
			while( $j <= $n && ($_ = <INPUT>)) {
			    $block[$j++] = $_;
#                           print "Retrieved line $j:\n$_";
			    $key .= substr $_, $offset;
			    select undef, undef, undef, 0.5; # wait a half second
			}
                    } else {
			while(<INPUT>) {
			    push(@block, $_);
			    print "Retrieved line:\n$_ Pattern: $pat\n";
#			    last if $_ =~ /$pat/i;
			    last if /$pat/i;
#			    $key .= substr $_, $offset;
			    select undef, undef, undef, 0.5; # wait a half second
			}
		    }
		    $curpos = tell INPUT;
                }
                
                $_ = $action[$str_index];
                my $t=time;
                $got_error = 1;
              SWITCH: {
# The following logic prevents the situation where an error message
# may occur multiple times, triggering the same action.
# Setting the variable $ERROR_TIMEOUT will prevent duplicate error messages
# from triggering an action more often than $ERROR_TIMEOUT seconds.
# Of course, the error messages must be indentical, and $offset must be
# set properly for it to work.

                  (/mail/ || /beep/ || /pipe/) && do {
                      if (! defined($errtime{$key}) ||
                          ($errtime{$key} + $ERROR_TIMEOUT) <= time) {
                          $errtime{$key} = time;
                      } else {
                          if ($errtime{$key} + $ERROR_TIMEOUT > time) {
                              print LOGFILE "Current time = $t; last error time was $errtime{$key}; skipping\n";
                              print LOGFILE $_;
                              last SWITCH;
                          }
                      }
                  };

                  /mail/ && do {
                      mail($actionargs[$str_index], @block);
                      last SWITCH;
                  };
                  /beep/ && do {
                      beep($actionargs[$str_index], @block);
                      last SWITCH;
                  };
                  /pipe/ && do {
                      pipe($actionargs[$str_index], @block);
                      last SWITCH;
                  };
                  /exit/ && do {
                      close LOGFILE;
                      close INPUT;
                      exit 0;
                  };
                  /ignore/ && do {
                      last SWITCH;
                  };
                  // && do {
                      last SWITCH;
                  };

              }
            }
        }
    }
#    print "sl
    sleep 5;
    seek INPUT, $curpos, 0;
}

sub mail
{
    chomp(my $args = shift);
    my @lines = @_;

    my ($subject, $recipients) = split /\|/, $args;
    if (!defined($recipients) || $recipients eq "") {
        $recipients = $MAIL_RECIPIENTS;
    }
    chomp($subject = "*** $INPUT: $subject");
#    $command = "echo '@lines' | /usr/bin/Mail -s \'$subject' $recipients";
#    print LOGFILE "$command \n";
#    $output = `$command 2>&1`;
#    if ($? != 0) {
#        print LOGFILE "Error occurred while sending mail:\n$output";
#    }
    if(open(MAIL, "|/usr/sbin/sendmail -t")) {
	print MAIL "To: $recipients\n";
	print MAIL "Subject: $subject\n";
	print MAIL "\n";
	print MAIL @lines;
	close(MAIL);
    } else {
	print LOGFILE "Can't run sendmail: $!\n";
    }
}

sub beep
{
#    print "beeping...\n";
    my $args = shift;
    chomp $args;
#    print "Args are $args\n";
    my @lines = @_;

    my ($beep, $group, $recipients) = split /\|/, $args;
    if ($group eq "") {
        $group = "default";
    }
#    print length $recipients;
    if ($recipients eq "") {
        $recipients = $PAGING_GROUP;
    }

    my ($basename, $dir, $suffix) = fileparse($INPUT);
    my $pg_key = $basename;
# Create a key by taking every other character from the first line of the
# error message
#    print "creating key...\n";
    $key =~ s/\n/ /g;
    for ($i = 0; $i < length $key && length $pg_key < 32; $i += 2) {
        $pg_key .= substr($key, $i, 1);
    }
    my $msg = substr "$INPUT: $key", 0, 128;
    $key =~ s/ //g;
    my $command = "$BIN_DIR/pg_page.pl -G '$group' -g '$recipients' '$pg_key' '$msg'";
    print LOGFILE "$command\n";
    my $output = `$command 2>&1`;
    if ($? != 0) {
        print "Error occurred while sending beep:\n$output";
    }
}