#!/usr/bin/perl -w
#
# by JPK

use strict;
use warnings;
use POSIX qw(setsid setlocale strftime LC_ALL);
use Getopt::Long 2.25 qw(:config no_ignore_case bundling);
use Sys::Syslog qw(:DEFAULT setlogsock);
use vars qw( %Events $SOURCE $PIPE $PLEASEDIE $TAILPID );
$| = 1;


## SETTINGS

# Variables Anfangspattern der Syslog-Zeile (Datum, Zeit, ...)
my $LOGPRE	= qr/^([A-Z][a-z]{2})\s+(\d\d?)\s+(\d\d:\d\d:\d\d)\s+(\S+)\s+/;
my $SELF	= ( ($0 =~ m@/([^/]+)$@) ? $1 : $0 ); $SELF =~ s/\.pl$//;
my $VERSION	= '1.00';

# Globale Konfiguration
my %Options	= (
	'daemon'		=> 0,
	'path'			=> '/usr/bin:/bin:/usr/sbin:/sbin',
	'action'		=> 'note',
	'cleanup'		=> 1800,
	'interval'		=> 1,
	'reopen'		=> 0,
	'evalall'		=> 0,
	'debug'			=> 0,
	'test'			=> 0,
	# mail
	'from'			=> 'root@localhost',
	'to'			=> 'root@localhost',
	# syslog
	'syslog_name'		=> $SELF,
	'syslog_facility'	=> 'daemon',
	'syslog_prio'		=> 'info',
	'syslog_options'	=> 'pid',
	'syslog_socktype'	=> 'unix',
	'syslog_safe'		=> 0,
	'syslog_maxlen'		=> 0,
	'syslog_badchar'	=> qr/[^\x20-\x7E]/,
);

# Regeln - ueberschreiben ggf globale Einstellungen
my %Rules	= (
#	'R000'	=> {
#		'tag'		=> "CRITICAL",
#		'mask'		=> qr/fatal|panic|crit|failure|alarm|alert|oops/,
#		'interval'	=> 5,
#		'minimum'	=> 1,
#		'action'	=> 'note,mail',
#		'from'		=> 'jpk@example.local',
#		'to'		=> 'jpk@example.local',
#		'subject'	=> 'Critical event',
#	},
        'R001'  => {
                'tag'           => "ALL",
                'mask'          => qr/./,
                'interval'      => 1,
		'action'	=> 'note',
        },
);

# Verwendete SHell Befehle
my %Commands	= (
	'tail'	=> {
		'cmd'	=> 'tail',
		'arg'	=> '-0f',
	},
	'mail'	=> {
		'cmd'	=> 'sendmail',
		'arg'	=> '-i -f &&from -F &&from -r &&from &&to',
	},
);

my %Actions	= (
	'note'	=> sub {
		my($id,$count,$text) = @_;
		$count .= "x";
		rlog ( $id, "NOTE: $id"."[".$count."]:".( ($Rules{$id}{'tag'}) ? ' '.$Rules{$id}{'tag'}.':' : '')." $text" );
	},
	'mail'	=> sub {
		my($id,$count,$body) = @_;
		$count .= "x";
		my($from)	= $Rules{$id}{'from'} || $Options{'from'};
		my($to)		= $Rules{$id}{'to'} || $Options{'to'};
		my($subject)	= "$SELF ".$id."[$count]: ".($Rules{$id}{'subject'} || $Rules{$id}{'tag'} || '');
		my($cmd) = "echo -n \"Subject: $subject\n\n$body\n\" | ".$Commands{'mail'}{'cmd'}." ".$Commands{'mail'}{'arg'};
		$cmd = devar ( $id, $cmd );
		rlog ( $id, "MAIL: $id"."[".$count."]: ".$cmd );
		qx( $cmd );
	},
);

my $OLDARG0 = $0;
my @OLDARGV = @ARGV;


## SUBS

sub mylog {
	my($prio) = shift(@_);
	my($msg)  = shift(@_);
	# truncate syslogs (--loglen option)
	$msg = substr($msg, 0, $Options{'syslog_maxlen'}) if $Options{'syslog_maxlen'};
	# escape dangerous characters
	$msg =~ s/\%/%%/g; $msg =~ s/$Options{'syslog_badchar'}/?/g if $Options{'syslog_badchar'};
	if ($Options{'daemon'}) {
		# Sys::Syslog < 0.15 dies when syslog daemon is temporarily not
		# present (for example on syslog rotation)
		if ($Options{'syslog_safe'}) {
			eval { local $SIG{__DIE__} = sub { }; syslog $prio, "$msg", @_ };
		} else {
			syslog $prio, "$msg", @_;
		};
	} else { printf "[LOG $prio]: $msg\n", @_ };
};
sub rlog  { return unless my $id = shift; mylog ( ($Rules{$id}{'syslog_prio'} || $Options{'syslog_prio'} || 'info'), @_ ) };
sub info  { mylog 'info', @_ };
sub note  { mylog 'notice', @_ };
sub error { mylog 'warning', @_ };
sub fatal { mylog 'crit', @_ };
sub debug { mylog 'info', @_ if $Options{'debug'} };

sub devar {
	my($id,$var) = @_;
	while ($var =~ m/&&(\S+)\b/) {
		my $v = $1;
		if (defined $Rules{$id}{$v}) {
			$var =~ s/&&$v/$Rules{$id}{$v}/;
		} elsif (defined $Options{$v}) {
			$var =~ s/&&$v/$Options{$v}/;
		} else {
			$var =~ s/&&$v//;
		};
	};
	return $var;
};

sub cleanup {
	my $now = shift;
	return ($now + $Options{'cleanup'}) unless (%Events);
	my $t = $now; my $a = my $c = 0;
	map { $a++; if (defined $Events{$_}{'until'} and $t > $Events{$_}{'until'}) { $c++; delete $Events{$_} } } ( keys %Events );
	debug "CLEANUP: Removed $c/$a events" if $a;
	return ($now + $Options{'cleanup'});
};

sub pipestop {
	if ( $TAILPID and kill(0, $TAILPID) ) {
		debug "FILE: Closing file $SOURCE at PID $TAILPID";
		kill ("TERM", $TAILPID);
	};
	close $PIPE if $PIPE;
};

sub pipestart {
	pipestop();
	$TAILPID = open $PIPE, "-|", $Commands{'tail'}{'cmd'}, $Commands{'tail'}{'arg'}, $SOURCE
		or die "\nERROR: Can not execute \`".$Commands{'tail'}{'cmd'}." ".$Commands{'tail'}{'arg'}." $SOURCE\`\n\n";
	debug "FILE: Opening file $SOURCE at PID $TAILPID";
};

sub end_program {
	saveevents();
	pipestop();
	note "Stopping $SELF $VERSION";
	exit;
};

sub restartme { saveevents(); pipestop(); exec($OLDARG0, @OLDARGV) or die "ERROR: Could not restart $SELF: $!" };

sub list_to_hash {
	my @input = @_; my %output = (); my $id = ''; my $lc = 0;
	INPUT: for (@input) {
		chomp; $lc++;
		next if /^\s*#/ or /^\s*$/;
		if ( /^\s*id\s*=\s*(.*)$/ ) {
			$id = $1;
			error "Line $lc: ID $id: Duplicate ID" if defined $output{$id};
		} elsif ( /^\s*([^=\s]+)\s*=\s*(.*?)\s*$/ ) {
			if ($id) {
				if (defined $output{$id}{$1}) {
					error "Line $lc: ID $id: Overriding item '$1' (was '".$output{$id}{$1}."', becomes '".($2 || '')."')";
				};
				$output{$id}{$1} = $2 || '';
			} else {
				error "Line $lc: No ID has been set - ignoring line '$_'";
			};
		} else {
			error "Line $lc: Unknown syntax - ignoring line '$_'";
		};
	};
	return %output;
};

sub hash_to_list {
	my %input = @_; my @output = ();
	foreach my $id (sort keys %input) {
		push @output, "id=$id";
		foreach my $key (sort keys %{$input{$id}}) {
			push @output, "\t$key = ".($input{$id}{$key} || '');
		};
	};
	return @output;
};

sub checkrules {
	RULECHECK: foreach my $id ( sort keys %Rules ) {
		if (defined $Rules{$id}{'mask'}) {
			$Rules{$id}{'mask'} =~ s@^/@@; $Rules{$id}{'mask'} =~ s@/([a-z]?)$@@;
			$Rules{$id}{'mask'} = ($1 eq 'i') ? qr/$Rules{$id}{'mask'}/i : qr/$Rules{$id}{'mask'}/;
		} else {
			error "Disabling rule $id: No mask has been specified!";
			delete $Rules{$id};
			next RULECHECK;
		};
	};
};

sub loadrules {
	return unless $Options{'rules'};
	open (IN, "<".$Options{'rules'})
		or die "ERROR: Can not open rules at ".$Options{'rules'}.": $!\n";
	%Rules = list_to_hash(<IN>);
	close IN;
	unless (%Rules) {
		error "No rules found at ".$Options{'rules'};
	} else {
		checkrules();
		debug "RULE: Loaded ".(scalar keys %Rules)." rules from ".$Options{'rules'};
	};
};

sub saveevents {
	return unless $Options{'events'};
	cleanup(time()) if $Options{'cleanup'};
	unless (%Events) {
		if ( -f $Options{'events'} ) {
			debug "EVENT: No current events. Removing event-cache ".$Options{'events'};
			unlink $Options{'events'}
				or note "Can not unlink event-cache ".$Options{'events'};
		};
		return;
	};
	if ( -l $Options{'events'} ) {
		error "No symlink for event-cache ".$Options{'events'}." allowed";
		return;
	};
	note "Overwriting existing event-cache ".$Options{'events'} if ( -f $Options{'events'} );
	unless ( open(EOUT, ">".$Options{'events'}) ) {
		error "Can not open event-cache ".$Options{'events'}." for writing: $!";
		return;
	};
	debug "EVENT: Saving ".(scalar keys %Events)." events to ".$Options{'events'};
	map { print EOUT "$_\n" } hash_to_list(%Events);
	close EOUT;
};

sub loadevents {
	return unless $Options{'events'};
	if ( -l $Options{'events'} ) {
		error "No symlink for event-cache ".$Options{'events'}." allowed";
		return;
	};
	return unless ( -f $Options{'events'} );
	open (EIN, "<".$Options{'events'})
		or die "ERROR: Can not open event-cache at ".$Options{'events'}.": $!\n";
	%Events = list_to_hash(<EIN>);
	close EIN;
	if (%Events) {
		debug "EVENT: Loaded ".(scalar keys %Events)." events from ".$Options{'events'};
		cleanup(time()) if $Options{'cleanup'};
	};
};

# sysloggubg
sub initlog {
	# Syslog initialisieren
	if ( defined $Sys::Syslog::VERSION and $Sys::Syslog::VERSION ge '0.15' ) {
		$Options{'syslog_socktype'} = 'native';
		$Options{'syslog_options'} .= ',nofatal';
	} elsif ( $^O eq 'solaris' ) {
		# 'stream' is broken and 'unix' doesn't work on Solaris:
		# only 'inet' seems to be useable with Sys::Syslog < 0.15
		$Options{'syslog_socktype'} = 'inet';
	} else { $Options{'syslog_safe'} = 1 };
	setlogsock $Options{'syslog_socktype'};
	$Options{'syslog_options'} = 'cons,pid' unless $Options{'daemon'};
	openlog $Options{'syslog_name'}, $Options{'syslog_options'}, $Options{'syslog_facility'};
	debug "Sys::Syslog ".($Sys::Syslog::VERSION || '')." initialized";
};

# security settings
sub secureme {
	# change to root dir, set safe locale and file mode
	setlocale(LC_ALL, 'C'); umask(0077);
	chdir '/' or die "ERROR: can not chdir to /: $!\n";
	# get user- and group-settings
	if ( $Options{'user'} and $Options{'group'} ) {
		my $uid = getpwnam($Options{'user'})  or die "ERROR: can not get uid for ".$Options{'user'}."\n";
		my $gid = getgrnam($Options{'group'}) or die "ERROR: can not get gid for ".$Options{'group'}."\n";
		my $homedir = (getpwnam($Options{'user'}))[7];
		# change user- and group-id
		$) = "$gid $gid"; $( = $gid; $> = $< = $uid;
		# cleanup environment
		if ($homedir) { $ENV{HOME} = $homedir } else { delete $ENV{HOME} if defined $ENV{HOME} };
		delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
		debug "Applied security settings uid=".$Options{'user'}."($uid), gid=".$Options{'group'}."($gid), home=$ENV{HOME}";
	};
};

# daemonize
sub daemonize {
	# pretty command line in ps
	$0 = join (' ', $OLDARG0, @OLDARGV);
	# close our streams stdin and stdout
	close STDIN; close STDOUT; close STDERR;
	open STDIN,  "</dev/null" or die "ERROR: can not read from /dev/null: $!\n";
	open STDOUT, ">/dev/null" or die "ERROR: can not write to /dev/null: $!\n";
	# background execution
	my $i=fork();
	if(!defined $i) { die "ERROR: can not fork new master process\n"; }
	if($i>0) { exit(0); }
	setsid() or die "ERROR: can not setsid to background\n";
	# catch signals
	$SIG{__DIE__}  = sub { fatal "FATAL: $_[0]" unless ($^S or $PLEASEDIE) };
	$SIG{__WARN__} = sub { error "WARN: $_[0]" };
	$SIG{TERM} = sub { $PLEASEDIE = 1; end_program() };
	$SIG{INT} = sub { $PLEASEDIE = 1; end_program() };
	$SIG{HUP} = sub { note "Catched HUP signal"; restartme() };
	if ( $Options{'reopen'} ) {
		$SIG{ALRM} = sub { note "Re-open time expired"; restartme() };
		alarm ($Options{'reopen'});
	};
	# now close stderr, too
	open STDERR, '>&STDOUT' or die "ERROR: can not duplicate stderr to stdout: $!\n";
	info "Starting $SELF $VERSION";
};


## MAIN

# Kommandozeile und Parameter vorbereiten
my $USAGE = <<"__EOUSAGE__";
USAGE: $SELF [ OPTIONS ] <file>

	Files:
	-f, --file=<f>			load rules from file <f>
	-e, --events=<f>		use file <f> as event-cache

	Control:
	-v, --verbose			detailed logging information
	-d, --daemon			fork to background after execution
	-r, --reopen=<i>		re-open <file> any <i> seconds [$Options{reopen}]
	-c, --cleanup=<i>		cleanup event database any <i> seconds [$Options{cleanup}]
	-a, --action=<s>		default action, may be overidden per rule [$Options{action}]
	-i, --interval=<i>		default notification interval, also per rule [$Options{interval}]
	-x, --evalall			evaluate all rules (dont stop after a hit) [off]

	Mail:
	    --from=<s>			default sender address, also per rule [$Options{from}]
	    --to=<s>			default recipient address, also per rule [$Options{to}]

	Syslog:
	    --syslog_prio=<s>		default syslog priority, also per rule [$Options{syslog_prio}]
	    --syslog_facility=<s>	syslog facility [$Options{syslog_facility}]
	    --syslog_name=<s>		syslog label [$Options{syslog_name}]

	Info:
	-V, --version			version information
	-h, --help			this cruft
__EOUSAGE__
GetOptions( \%Options,
	# control
	'daemon|d|D', 'debug|verbose|v', 'test|t|T', 'evalall|x',
	'reopen|r=i', 'interval|i=i', 'cleanup|c=i', 'action|a=s',
	# files
	'rules|file|f=s', 'events|save|e=s',
	# mail
	'from|mailfrom|sender=s', 'to|mailto|recipient|recipients=s',
	# syslog
	'syslog_name=s', 'syslog_facility=s', 'syslog_prio=s', 'syslog_options=s',
	'syslog_socktype=s', 'syslog_safe', 'syslog_maxlen=i',
	# help and version
	'version|V'	=> sub{ print STDERR "$SELF $VERSION".( (defined $Sys::Syslog::VERSION) ? " (Sys::Syslog ".$Sys::Syslog::VERSION.")" : '' )." using perl ".$]." on ".$^O."\n"; exit(1) },
	'help|h|H'	=> sub{ print STDERR "\n$SELF $VERSION\n\n$USAGE\n\n"; exit(1) },
) or die "\n$USAGE\n\n";
die "\nERROR: Wrong arguments\n$USAGE\n\n" unless $#ARGV == 0;
( -e $ARGV[0] ) or die "\nERROR: Can not find $ARGV[0]\n\n";
$SOURCE = $ARGV[0];

# initialize logging
initlog();

# initialize tools
$ENV{'PATH'} = $Options{'path'} || '/usr/bin:/bin:/usr/sbin:/sbin';
map { my $p = qx(which $Commands{$_}{'cmd'}); die "\nERROR: ".$Commands{$_}{'cmd'}." not found in path ".$Options{'path'}."\n\n" unless $p; chomp($p); debug "Path to ".$Commands{$_}{'cmd'}." command = $p" } ( keys %Commands );

# fork to background if requested
if ($Options{'daemon'}) {
	# apply security settings
	secureme();
	# daemonize and remember parent pid
	daemonize();
};

# load rules
loadrules();

# optionally load saved events
loadevents();

my $cleanupat = time() + ($Options{'cleanup'} || 0);
while (1) {
	pipestart();
	PIPE: while (<$PIPE>) {
		my $now = time();
		$cleanupat = cleanup($now) if $Options{'cleanup'} and $now > $cleanupat;
		chomp;
		# skip non-syslog lines
		next PIPE unless s/$LOGPRE//;
		# skip own syslogs
		next PIPE if /^([^[\s]+)[\[\s]/ and $1 eq $SELF;
		my ( $mon, $day, $time, $host, $rest ) = ( $1, $2, $3, $4, $_ );
		MASK: foreach my $id (sort keys %Rules) {
			next MASK unless defined $Rules{$id}{'mask'} and $rest =~ /$Rules{$id}{'mask'}/;
			$rest = $1 if $1; $Events{$rest}{'count'}++;
			next MASK if defined $Events{$rest} and defined $Events{$rest}{'until'} and $now < $Events{$rest}{'until'};
			next MASK if defined $Rules{$id}{'minimum'} and $Rules{$id}{'minimum'} > $Events{$rest}{'count'};
			foreach my $action ( split /[,\s]+/, ($Rules{$id}{'action'} || $Options{'action'}) ) {
				( defined $Actions{$action} )
					? &{$Actions{$action}} ( $id, $Events{$rest}{'count'}, $rest )
					: error "WARNING: Rule $id ignoring undefined action '$action'";
			};
			$Events{$rest}{'until'} = $now + ($Rules{$id}{'interval'} || $Options{'interval'});
			$Events{$rest}{'count'} = 0;
			last MASK unless $Options{'evalall'} or $Rules{$id}{'goon'};
		};
	};
};

die "\nSorry - $SELF can not be run on systems, that pass a while(1) loop in a defined timespan\n\n";