#!/usr/bin/perl -w
#
# SEC (Simple Event Correlator) 2.4.1 - sec.pl
# Copyright (C) 2000-2007 Risto Vaarandi
#
# 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#
package main::SEC;
# Parameters: par1 - perl code to be evaluated
# par2 - if set to 0, the code will be evaluated in scalar
# context; if 1, list context is used for evaluation
# Action: calls eval() for the perl code par1, and returns an array with
# the eval() return value(s). The first element of the array
# indicates whether the code was evaluated successfully (i.e.,
# the compilation didn't fail). If code evaluation fails, the
# first element of the return array contains the error string.
sub call_eval {
my($code) = $_[0];
my($listcontext) = $_[1];
my($ok, @result);
$ok = 1;
if ($listcontext) {
@result = eval $code;
} else {
$result[0] = eval $code;
}
if ($@) {
$ok = 0;
chomp($result[0] = $@);
}
return ($ok, @result);
}
######################################################################
package main;
use strict;
##### List of global variables #####
use vars qw(
$blocksize
$bufpos
$bufsize
@calendar
$check_timeout
%children
$cleantime
@conffilepat
@conffiles
%config_ltimes
%config_mtimes
%configuration
%context_list
%corr_list
$debuglevel
$detach
$dumpdata
$dumpfile
@events
$evstoresize
$fromstart
$help
@inputfilepat
@inputfiles
%inputsrc
@input_buffer
@input_sources
$input_timeout
$intcontexts
$intevents
%int_contexts
$lastcleanuptime
$lastconfigload
$logfile
$openlog
@pending_events
$pidfile
$poll_timeout
$processedlines
$quoting
$rcfile_status
@readbuffer
$refresh
$reopen_timeout
$SEC_COPYRIGHT
$SEC_LICENSE
$SEC_USAGE
$SEC_VERSION
$SYSLOGAVAIL
$sec_options
$softrefresh
$startuptime
$syslogf
$tail
$terminate
$testonly
$timeout_script
%variables
$version
$WIN32
);
##### Load modules and set some global variables #####
use Getopt::Long;
use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END setsid);
use Fcntl;
use IO::Handle;
# check if Sys::Syslog is available
$SYSLOGAVAIL = eval { require Sys::Syslog };
# check if the platform is win32
$WIN32 = ($^O =~ /win/i && $^O !~ /cygwin/i && $^O !~ /darwin/i);
# set version and usage variables
$SEC_VERSION = "SEC (Simple Event Correlator) 2.4.1";
$SEC_COPYRIGHT = "Copyright (C) 2000-2007 Risto Vaarandi";
$SEC_USAGE = qq!Usage: $0 [options]
Options:
-conf=<file pattern> ...
-input=<file pattern>[=<context>] ...
-input_timeout=<input timeout>
-timeout_script=<timeout script>
-reopen_timeout=<reopen timeout>
-check_timeout=<check timeout>
-poll_timeout=<poll timeout>
-blocksize=<io block size>
-bufsize=<input buffer size>
-evstoresize=<event store size>
-cleantime=<clean time>
-log=<logfile>
-syslog=<facility>
-debug=<debuglevel>
-pid=<pidfile>
-dump=<dumpfile>
-quoting, -noquoting
-tail, -notail
-fromstart, -nofromstart
-detach, -nodetach
-intevents, -nointevents
-intcontexts, -nointcontexts
-testonly, -notestonly
-help, -?
-version
!;
$SEC_LICENSE = q!
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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!;
##### List of internal constants #####
use constant CONFIG_KEYWORDS => {
type => 1,
continue => 1,
ptype => 1,
pattern => 1,
context => 1,
desc => 1,
action => 1,
window => 1,
thresh => 1,
continue2 => 1,
ptype2 => 1,
pattern2 => 1,
context2 => 1,
desc2 => 1,
action2 => 1,
window2 => 1,
thresh2 => 1,
time => 1,
script => 1,
rem => 1
};
use constant INVALIDVALUE => -1;
use constant SINGLE => 0;
use constant SINGLE_W_SUPPRESS => 1;
use constant SINGLE_W_SCRIPT => 2;
use constant PAIR => 3;
use constant PAIR_W_WINDOW => 4;
use constant SINGLE_W_THRESHOLD => 5;
use constant SINGLE_W_2_THRESHOLDS => 6;
use constant SUPPRESS => 7;
use constant CALENDAR => 8;
use constant SUBSTR => 0;
use constant REGEXP => 1;
use constant PERLFUNC => 2;
use constant NSUBSTR => 3;
use constant NREGEXP => 4;
use constant NPERLFUNC => 5;
use constant TVALUE => 6;
use constant DONTCONT => 0;
use constant TAKENEXT => 1;
use constant NONE => 0;
use constant LOGONLY => 1;
use constant WRITE => 2;
use constant SHELLCOMMAND => 3;
use constant SPAWN => 4;
use constant PIPE => 5;
use constant CREATECONTEXT => 6;
use constant DELETECONTEXT => 7;
use constant OBSOLETECONTEXT => 8;
use constant SETCONTEXT => 9;
use constant ALIAS => 10;
use constant UNALIAS => 11;
use constant ADD => 12;
use constant FILL => 13;
use constant REPORT => 14;
use constant COPYCONTEXT => 15;
use constant EMPTYCONTEXT => 16;
use constant EVENT => 17;
use constant RESET => 18;
use constant ASSIGN => 19;
use constant EVAL => 20;
use constant CALL => 21;
use constant OPERAND => 0;
use constant NEGATION => 1;
use constant AND => 2;
use constant OR => 3;
use constant EXPRESSION => 4;
use constant ECODE => 5;
use constant CCODE => 6;
use constant EXPRSYMBOL => "\0";
use constant LOG_CRIT => 1;
use constant LOG_ERR => 2;
use constant LOG_WARN => 3;
use constant LOG_NOTICE => 4;
use constant LOG_INFO => 5;
use constant LOG_DEBUG => 6;
use constant SYSLOG_LEVELS => {
1 => "crit",
2 => "err",
3 => "warning",
4 => "notice",
5 => "info",
6 => "debug"
};
use constant SEPARATOR => " | ";
use constant TERMTIMEOUT => 3;
###############################################################
# ------------------------- FUNCTIONS -------------------------
###############################################################
##############################
# Functions related to logging
##############################
# Parameters: par1 - name of the logfile
# Action: logfile will be opened. Filehandle of the logfile will be
# saved to the global filehandle LOGFILE.
sub open_logfile {
my($logfile) = $_[0];
if (open(LOGFILE, ">>$logfile")) {
select LOGFILE;
$| = 1;
select STDOUT;
} else {
if (-t STDERR || -f STDERR) {
print STDERR "Can't open logfile $logfile ($!), exiting!\n";
}
child_cleanup();
exit(1);
}
}
# Parameters: par1 - syslog facility
# Action: open connection to the system logger with the facility par1.
sub open_syslog {
my($facility) = $_[0];
my($progname);
if (!$SYSLOGAVAIL) {
if (-t STDERR || -f STDERR) {
print STDERR "Can't connect to syslog (no Sys::Syslog), exiting!\n";
}
child_cleanup();
exit(1);
}
$progname = $0;
$progname =~ s/.*\///;
eval { Sys::Syslog::openlog($progname, "pid", $facility) };
if ($@) {
if (-t STDERR || -f STDERR) {
print STDERR "Can't connect to syslog ($@), exiting!\n";
}
child_cleanup();
exit(1);
}
}
# Parameters: par1 - severity of the log message
# par2, par3, ... - strings to be logged
# Action: if par1 is smaller or equal to the current logging level (i.e.,
# the message must be logged), then strings par2, par3, ...
# will be equipped with timestamp and written to LOGFILE and/or
# forwarded to the system logger as a single line. If STDERR is
# connected to terminal, message will also be written there.
sub log_msg {
my($level) = shift(@_);
my($ltime, $msg);
if ($debuglevel < $level) { return; }
if (!$logfile && !$syslogf && ! -t STDERR) { return; }
$msg = join(" ", @_);
if (-t STDERR) { print STDERR "$msg\n"; }
if ($logfile) {
$ltime = localtime(time());
print LOGFILE "$ltime: $msg\n";
}
if ($syslogf) {
$msg =~ s/%/%%/g;
eval { Sys::Syslog::syslog(SYSLOG_LEVELS->{$level}, $msg) };
}
}
#######################################################
# Functions related to configuration file(s) processing
#######################################################
# Parameters: par1 - value to be checked
# Action: return 1 if par1 is 0 or positive integer, 0 otherwise
# ($value must consist of 0-9 characters only for 1 to be returned,
# no leading or trailing whitespace symbols are permitted)
sub is_uinteger {
my($value) = $_[0];
return !($value =~ tr/[0-9]//cd);
}
# Parameters: par1, par2, .. - strings
# Action: All 2-byte substrings in par1, par2, .. that denote special
# symbols ("\n", "\t", ..) will be replaced with corresponding
# special symbols
sub subst_specchar {
my(%specchar, $string);
$specchar{"0"} = "";
$specchar{"n"} = "\n";
$specchar{"r"} = "\r";
$specchar{"s"} = " ";
$specchar{"t"} = "\t";
$specchar{"\\"} = "\\";
foreach $string (@_) {
$string =~ s/\\(0|n|r|s|t|\\)/$specchar{$1}/g;
}
}
# Parameters: par1 - expression
# par2 - reference to an array
# Action: parentheses and their contents will be replaced with special
# symbols EXPRSYMBOL in par 1. The expressions inside parentheses
# will be returned in par2. Previous content of the array par2
# is erased. If par1 was parsed successfully, the modified par1
# will be returned, otherwise undef is returned.
sub replace_subexpr {
my($expression) = $_[0];
my($expr_ref) = $_[1];
my($i, $j, $l, $pos);
my($char, $prev);
@{$expr_ref} = ();
$i = 0;
$j = 0;
$l = length($expression);
$pos = undef;
$prev = "";
while ($i < $l) {
# process expression par1 from the start and inspect every symbol,
# adding 1 to $j for every '(' and subtracting 1 for every ')';
# if a parenthesis is masked with a backslash, it is ignored
$char = substr($expression, $i, 1);
if ($prev ne "\\") {
if ($char eq "(") { ++$j; } elsif ($char eq ")") { --$j; }
}
# After observing first '(' save its position to $pos;
# after observing its counterpart ')' replace everything
# from '(' to ')' with EXPRSYMBOL (including possible nested
# expressions), and save the content of parentheses;
# if at some point $j becomes negative, the parentheses must
# be unbalanced
if ($j == 1 && !defined($pos)) { $pos = $i; }
elsif ($j == 0 && defined($pos)) {
# take symbols starting from position $pos+1 (next symbol after
# '(') up to position $i-1 (the symbol before ')'), and save
# the symbols to array
push @{$expr_ref}, substr($expression, $pos + 1, $i - $pos - 1);
# replace both the parentheses and the symbols between them
# with EXPRSYMBOL
substr($expression, $pos, $i - $pos + 1) = EXPRSYMBOL;
# set the variables according to changes in expression
$i = $pos;
$l = length($expression);
$pos = undef;
$char = "";
}
elsif ($j < 0) { return undef; } # extra ')' was found
$prev = $char;
++$i;
}
# if the parsing ended with non-zero $j, the parentheses were unbalanced
if ($j == 0) { return $expression; } else { return undef; }
}
# Parameters: par1 - continue value (string)
# par2 - the name of the configuration file
# par3 - line number in configuration file
# Action: par1 will be analyzed and the integer continue value will be
# returned. If errors are found when analyzing par1, error message
# about improper line par3 in configuration file will be logged.
sub analyze_continue {
my($continue) = $_[0];
my($conffile) = $_[1];
my($lineno) = $_[2];
if (uc($continue) eq "TAKENEXT") { return TAKENEXT; }
elsif (uc($continue) eq "DONTCONT") { return DONTCONT; }
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid continue value '$continue'");
return INVALIDVALUE;
}
# Parameters: par1 - pattern type (string)
# par2 - pattern
# par3 - the name of the configuration file
# par4 - line number in configuration file
# par5 - if we are dealing with the second pattern of Pair*
# rule, par5 contains the type of the first pattern
# Action: par1 and par2 will be analyzed and tuple of integers
# (pattern type, line count, compiled pattern) will be returned
# (line count shows how many lines the pattern is designed to match).
# If errors are found when analyzing par1 and par2, error message
# about improper line par4 in configuration file will be logged.
sub analyze_pattern {
my($pattype) = $_[0];
my($pat) = $_[1];
my($conffile) = $_[2];
my($lineno) = $_[3];
my($negate, $lines);
my($evalok, $retval);
if ($pattype =~ /^(n?)regexp(\d*)$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (length($2)) { $lines = $2; } else { $lines = 1; }
if ($lines > $bufsize || $lines < 1) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid linecount $lines in '$pattype'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
eval { "" =~ /$pat/; };
if ($@) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid regular expression '$pat'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
if (!defined($_[4]) || $_[4] == TVALUE
|| $_[4] == SUBSTR || $_[4] == NSUBSTR) { $pat = qr/$pat/; }
if ($negate) { return (NREGEXP, $lines, $pat); }
else { return (REGEXP, $lines, $pat); }
} elsif ($pattype =~ /^(n?)substr(\d*)$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (length($2)) { $lines = $2; } else { $lines = 1; }
if ($lines > $bufsize || $lines < 1) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid linecount $lines in '$pattype'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
subst_specchar($pat);
if ($negate) { return (NSUBSTR, $lines, $pat); }
else { return (SUBSTR, $lines, $pat); }
} elsif ($pattype =~ /^(n?)perlfunc(\d*)$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (length($2)) { $lines = $2; } else { $lines = 1; }
if ($lines > $bufsize || $lines < 1) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid linecount $lines in '$pattype'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
($evalok, $retval) = SEC::call_eval($pat, 0);
if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid function '$pat'", defined($retval)?"($retval)":"");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
if ($negate) { return (NPERLFUNC, $lines, $retval); }
else { return (PERLFUNC, $lines, $retval); }
} elsif ($pattype =~ /^tvalue$/i) {
if (uc($pat) ne "TRUE" && uc($pat) ne "FALSE") {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid truth value '$pat'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
return (TVALUE, 1, uc($pat) eq "TRUE");
}
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid pattern type '$pattype'");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
# Parameters: par1 - action
# par2 - the name of the configuration file
# par3 - line number in configuration file
# par4 - rule ID
# Action: par1 will be analyzed and pair of integers
# (action type, action description) will be returned. If errors
# are found when analyzing par1, error message about improper
# line par3 in configuration file will be logged.
sub analyze_action {
my($action) = $_[0];
my($conffile) = $_[1];
my($lineno) = $_[2];
my($ruleid) = $_[3];
my($file, $cmdline, $progname);
my($sign, $rule);
my($actionlist, @action);
my($createafter, $event);
my($lifetime, $context, $alias);
my($variable, $value, $code, $codeptr, $params);
if ($action =~ /^none$/i) { return NONE; }
elsif ($action =~ /^logonly\b\s*(.*)/i) {
$event = $1;
# strip outer parentheses if they exist
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$event =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
return (LOGONLY, $event);
}
elsif ($action =~ /^write\s+(\S+)\s*(.*)/i) {
$file = $1;
$event = $2;
# strip outer parentheses if they exist
if ($file =~ /^\s*\(\s*(.*)\)\s*$/) { $file = $1; }
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$file =~ s/\\([\(\)])/$1/g;
$event =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
return (WRITE, $file, $event);
}
elsif ($action =~ /^shellcmd\s+(.*\S)/i) {
$cmdline = $1;
# strip outer parentheses if they exist
if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; }
# remove backslashes in front of the parentheses
$cmdline =~ s/\\([\(\)])/$1/g;
$progname = (split(' ', $cmdline))[0];
if (! -f $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - could not find '$progname'");
} elsif (! -x $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - '$progname' is not executable");
}
return (SHELLCOMMAND, $cmdline);
}
elsif ($action =~ /^spawn\s+(.*\S)/i) {
if ($WIN32) {
log_msg(LOG_ERR, "'spawn' action is not supported on Win32");
return INVALIDVALUE;
}
$cmdline = $1;
# strip outer parentheses if they exist
if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; }
# remove backslashes in front of the parentheses
$cmdline =~ s/\\([\(\)])/$1/g;
$progname = (split(' ', $cmdline))[0];
if (! -f $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - could not find '$progname'");
} elsif (! -x $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - '$progname' is not executable");
}
return (SPAWN, $cmdline);
}
elsif ($action =~ /^pipe\s+'([^']*)'\s*(.*)/i) {
$event = $1;
$cmdline = $2;
# strip outer parentheses if they exist
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; }
# remove backslashes in front of the parentheses
$event =~ s/\\([\(\)])/$1/g;
$cmdline =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
if (length($cmdline)) {
$progname = (split(' ', $cmdline))[0];
if (! -f $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - could not find '$progname'");
} elsif (! -x $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - '$progname' is not executable");
}
}
return (PIPE, $event, $cmdline);
}
elsif ($action =~ /^create\b\s*(\S*)\s*(\S*)\s*(.*)/i) {
$context = $1;
$lifetime = $2;
$actionlist = $3;
if (length($lifetime) && !is_uinteger($lifetime)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Context '$context' has invalid lifetime '$lifetime'");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($actionlist =~ /^\s*\(\s*(.*)\)\s*$/) { $actionlist = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
if (!length($context)) { $context = "%s"; }
if (!length($lifetime)) { $lifetime = 0; }
if (!$lifetime && length($actionlist)) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Context '$context' has infinite lifetime,",
"ignoring actionlist '$actionlist'");
$actionlist = "";
}
if (length($actionlist)) {
if (!analyze_actionlist($actionlist, \@action,
$conffile, $lineno, $ruleid)) { return INVALIDVALUE; }
return (CREATECONTEXT, $context, $lifetime, [ @action ]);
}
return (CREATECONTEXT, $context, $lifetime, []);
}
elsif ($action =~ /^delete\b\s*(\S*)\s*$/i) {
$context = $1;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
if (!length($context)) { $context = "%s"; }
return (DELETECONTEXT, $context);
}
elsif ($action =~ /^obsolete\b\s*(\S*)\s*$/i) {
$context = $1;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
if (!length($context)) { $context = "%s"; }
return (OBSOLETECONTEXT, $context);
}
elsif ($action =~ /^set\s+(\S+)\s+(\S+)\s*(.*)/i) {
$context = $1;
$lifetime = $2;
$actionlist = $3;
if (!is_uinteger($lifetime)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Context '$context' has invalid lifetime '$lifetime'");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($actionlist =~ /^\s*\(\s*(.*)\)\s*$/) { $actionlist = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
if (!$lifetime && length($actionlist)) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Context '$context' has infinite lifetime,",
"ignoring actionlist '$actionlist'");
$actionlist = "";
}
if (length($actionlist)) {
if (!analyze_actionlist($actionlist, \@action,
$conffile, $lineno, $ruleid)) { return INVALIDVALUE; }
return (SETCONTEXT, $context, $lifetime, [ @action ]);
}
return (SETCONTEXT, $context, $lifetime, []);
}
elsif ($action =~ /^alias\s+(\S+)\s*(\S*)\s*$/i) {
$context = $1;
$alias = $2;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($alias =~ /^\s*\(\s*(.*)\)\s*$/) { $alias = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
$alias =~ s/\\([\(\)])/$1/g;
if (!length($alias)) { $alias = "%s"; }
return (ALIAS, $context, $alias);
}
elsif ($action =~ /^unalias\b\s*(\S*)\s*$/i) {
$alias = $1;
# strip outer parentheses if they exist
if ($alias =~ /^\s*\(\s*(.*)\)\s*$/) { $alias = $1; }
# remove backslashes in front of the parentheses
$alias =~ s/\\([\(\)])/$1/g;
if (!length($alias)) { $alias = "%s"; }
return (UNALIAS, $alias);
}
elsif ($action =~ /^add\s+(\S+)\s*(.*)/i) {
$context = $1;
$event = $2;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
$event =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
return (ADD, $context, $event);
}
elsif ($action =~ /^fill\s+(\S+)\s*(.*)/i) {
$context = $1;
$event = $2;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
$event =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
return (FILL, $context, $event);
}
elsif ($action =~ /^report\s+(\S+)\s*(.*)/i) {
$context = $1;
$cmdline = $2;
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
$cmdline =~ s/\\([\(\)])/$1/g;
if (length($cmdline)) {
$progname = (split(' ', $cmdline))[0];
if (! -f $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - could not find '$progname'");
} elsif (! -x $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - '$progname' is not executable");
}
}
return (REPORT, $context, $cmdline);
}
elsif ($action =~ /^copy\s+(\S+)\s+(\S+)\s*$/i) {
$context = $1;
$variable = $2;
if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
return (COPYCONTEXT, $context, substr($variable, 1));
}
elsif ($action =~ /^empty\s+(\S+)\s*(\S*)\s*$/i) {
$context = $1;
$variable = $2;
if (length($variable) && $variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; }
# remove backslashes in front of the parentheses
$context =~ s/\\([\(\)])/$1/g;
if (!length($variable)) { return (EMPTYCONTEXT, $context, ""); }
return (EMPTYCONTEXT, $context, substr($variable, 1));
}
elsif ($action =~ /^event\b\s*(\d*)\b\s*(.*)/i) {
$createafter = $1;
$event = $2;
# strip outer parentheses if they exist
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$event =~ s/\\([\(\)])/$1/g;
if (!length($createafter)) { $createafter = 0; }
if (!length($event)) { $event = "%s"; }
return (EVENT, $createafter, $event);
}
elsif ($action =~ /^reset\b\s*([\+-]?)(\d*)\b\s*(.*)/i) {
$sign = $1;
$rule = $2;
$event = $3;
if (length($rule)) {
if ($sign eq "+") { $rule = $ruleid + $rule; }
elsif ($sign eq "-") { $rule = $ruleid - $rule; }
elsif (!$rule) { $rule = $ruleid; }
else { --$rule; }
} else { $rule = ""; }
# strip outer parentheses if they exist
if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; }
# remove backslashes in front of the parentheses
$event =~ s/\\([\(\)])/$1/g;
if (!length($event)) { $event = "%s"; }
return (RESET, $conffile, $rule, $event);
}
elsif ($action =~ /^assign\s+(\S+)\s*(.*)/i) {
$variable = $1;
$value = $2;
if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($value =~ /^\s*\(\s*(.*)\)\s*$/) { $value = $1; }
# remove backslashes in front of the parentheses
$value =~ s/\\([\(\)])/$1/g;
if (!length($value)) { $value = "%s"; }
return (ASSIGN, substr($variable, 1), $value);
}
elsif ($action =~ /^eval\s+(\S+)\s+(.*\S)/i) {
$variable = $1;
$code = $2;
if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($code =~ /^\s*\(\s*(.*)\)\s*$/) { $code = $1; }
# remove backslashes in front of the parentheses
$code =~ s/\\([\(\)])/$1/g;
return (EVAL, substr($variable, 1), $code);
}
elsif ($action =~ /^call\s+(\S+)\s+(\S+)\s*(.*)/i) {
$variable = $1;
$codeptr = $2;
$params = $3;
if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if ($codeptr !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $codeptr does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# strip outer parentheses if they exist
if ($params =~ /^\s*\(\s*(.*)\)\s*$/) { $params = $1; }
# remove backslashes in front of the parentheses
$params =~ s/\\([\(\)])/$1/g;
return (CALL, substr($variable, 1),
substr($codeptr, 1), [ split(' ', $params) ]);
}
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action '$action'");
return INVALIDVALUE;
}
# Parameters: par1 - action list separated by semicolons
# par2 - reference to an array
# par3 - the name of the configuration file
# par4 - line number in configuration file
# par5 - rule ID
# Action: par1 will be split to parts, each part is analyzed and saved
# to array @{$par2}. Previous content of the array is erased.
# Parameters par3..par5 will be passed to the analyze_action()
# function for logging purposes. Return 0 if an invalid action
# was detected in the list par1, otherwise return 1.
sub analyze_actionlist {
my($actionlist) = $_[0];
my($arrayref) = $_[1];
my($conffile) = $_[2];
my($lineno) = $_[3];
my($ruleid) = $_[4];
my(@parts, $part);
my($actiontype, @action);
my($newactionlist, @list, $expr);
my($pos, $l);
@{$arrayref} = ();
# replace the actions that are in parentheses with special symbols
# and save the actions to @list
$newactionlist = replace_subexpr($actionlist, \@list);
if (!defined($newactionlist)) { return 0; }
@parts = split(/\s*;\s*/, $newactionlist);
$l = length(EXPRSYMBOL);
foreach $part (@parts) {
# substitute special symbols with expressions
# that were removed previously
for (;;) {
$pos = index($part, EXPRSYMBOL);
if ($pos == -1) { last; }
$expr = shift @list;
substr($part, $pos, $l) = "(" . $expr . ")";
}
# analyze the action list part
($actiontype, @action) =
analyze_action($part, $conffile, $lineno, $ruleid);
if ($actiontype == INVALIDVALUE) { return 0; }
push @{$arrayref}, $actiontype, @action;
}
return 1;
}
# Parameters: par1 - context expression
# par2 - reference to an array
# Action: par1 will be analyzed and saved to array par2 in reverse
# polish notation form (it is assumed that par1 does not contain
# expressions in parentheses). Previous content of the array par2
# is erased. If errors are found when analyzing par1, 0 will be
# returned, otherwise 1 will be returned.
sub analyze_context_expr {
my($context) = $_[0];
my($result) = $_[1];
my($pos, $op1, $op2);
my(@side1, @side2);
my($evalok, $retval);
# if we are parsing '&&' and '||' operators that take 2 operands,
# process the context expression from the end with rindex(), in order
# to get "from left to right" processing for AND and OR at runtime
$pos = rindex($context, "||");
if ($pos != -1) {
$op1 = substr($context, 0, $pos);
$op2 = substr($context, $pos + 2);
if (!analyze_context_expr($op1, \@side1)) { return 0; }
if (!analyze_context_expr($op2, \@side2)) { return 0; }
@{$result} = ( @side1, @side2, OR );
return 1;
}
$pos = rindex($context, "&&");
if ($pos != -1) {
$op1 = substr($context, 0, $pos);
$op2 = substr($context, $pos + 2);
if (!analyze_context_expr($op1, \@side1)) { return 0; }
if (!analyze_context_expr($op2, \@side2)) { return 0; }
@{$result} = ( @side1, @side2, AND );
return 1;
}
# check for possible typos for '!' operator (any preceding illegal symbols)
$pos = index($context, "!");
if ($pos != -1) {
$op1 = substr($context, 0, $pos);
$op2 = substr($context, $pos + 1);
if ($op1 !~ /^\s*$/) { return 0; }
if (!analyze_context_expr($op2, \@side2)) { return 0; }
@{$result} = ( @side2, NEGATION );
return 1;
}
# since CCODE, ECODE and OPERAND are terminals, make sure that any
# leading and trailing whitespace is removed from their parameters
# (rest of the code relies on that); also, remove backslashes in front
# of the parentheses
if ($context =~ /^\s*(.*?)\s*->\s*(.*\S)/) {
$op1 = $1;
$op2 = $2;
if ($op1 ne EXPRSYMBOL) {
$op1 =~ s/\\([\(\)])/$1/g;
$op1 = [ split(' ', $op1) ];
}
if ($op2 ne EXPRSYMBOL) {
$op2 =~ s/\\([\(\)])/$1/g;
($evalok, $retval) = SEC::call_eval($op2, 0);
if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
log_msg(LOG_ERR, "Eval '$op2' didn't return a code reference:",
defined($retval)?$retval:"undef");
return 0;
}
$op2 = $retval;
}
@{$result} = ( CCODE, $op1, $op2 );
return 1;
}
if ($context =~ /^\s*=\s*(.*\S)/) {
$op1 = $1;
if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([\(\)])/$1/g; }
@{$result} = ( ECODE, $op1 );
return 1;
}
if ($context =~ /^\s*(.*\S)/) {
$op1 = $1;
if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([\(\)])/$1/g; }
@{$result} = ( OPERAND, $op1 );
return 1;
}
return 0;
}
# Parameters: par1 - context description
# par2 - reference to an array
# Action: par1 will be analyzed and saved to array par2 in reverse polish
# notation form. Previous content of the array par2 is erased.
# If errors are found when analyzing par1, 0 will be returned,
# otherwise 1 will be returned.
sub analyze_context {
my($context) = $_[0];
my($result) = $_[1];
my($newcontext, $i, $j);
my($params, $code, $evalok, $retval);
my($subexpr, @expr);
# replace upper level expressions in parentheses with special symbol
# and save the expressions to @expr (i.e. !(a && (b || c )) || d
# becomes !specialsymbol || d, and "a && (b || c )" is saved to @expr);
# if context was not parsed successfully, exit
$newcontext = replace_subexpr($context, \@expr);
if (!defined($newcontext)) { return 0; }
# convert the context to reverse polish notation, and if there
# were no parenthesized subexpressions found in the context during
# previous step, exit
if (!analyze_context_expr($newcontext, $result)) { return 0; }
if ($newcontext eq $context) { return 1; }
# If the context contains parenthesized subexpressions, analyze and
# convert these expressions recursively, attaching the results to
# the current context. If a parenthesized expression is a Perl code,
# it will not be analyzed recursively but rather treated as a terminal
# (backslashes in front of the parentheses are removed)
$i = 0;
$j = scalar(@{$result});
while ($i < $j) {
if ($result->[$i] == OPERAND) {
if ($result->[$i+1] eq EXPRSYMBOL) {
$result->[$i] = EXPRESSION;
$result->[$i+1] = [];
$subexpr = shift @expr;
if (!analyze_context($subexpr, $result->[$i+1])) { return 0; }
}
$i += 2;
}
elsif ($result->[$i] == ECODE) {
if ($result->[$i+1] eq EXPRSYMBOL) {
$code = shift @expr;
$code =~ s/\\([\(\)])/$1/g;
$result->[$i+1] = $code;
}
$i += 2;
}
elsif ($result->[$i] == CCODE) {
if ($result->[$i+1] eq EXPRSYMBOL) {
$params = shift @expr;
$params =~ s/\\([\(\)])/$1/g;
$result->[$i+1] = [ split(' ', $params) ];
}
if ($result->[$i+2] eq EXPRSYMBOL) {
$code = shift @expr;
$code =~ s/\\([\(\)])/$1/g;
($evalok, $retval) = SEC::call_eval($code, 0);
if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
log_msg(LOG_ERR, "Eval '$code' didn't return a code reference:",
defined($retval)?$retval:"undef");
return 0;
}
$result->[$i+2] = $retval;
}
$i += 3;
}
else { ++$i; }
}
return 1;
}
# Parameters: par1 - context description
# Action: if par1 is surrounded by [] brackets, the brackets will be
# removed and 1 will be returned, otherwise 0 will be returned.
sub check_context_preeval {
if ($_[0] =~ /^\s*\[(.*)\]\s*$/) {
$_[0] = $1;
return 1;
} else {
return 0;
}
}
# Parameters: par1 - list of the time values
# par2 - minimum possible value for time
# par3 - maximum possible value for time
# par4 - offset that must be added to every list value
# par5 - reference to a hash where every list value is added
# Action: take the list definition and find the time values that belong
# to the list (list definition is given in crontab-style).
# After the values have been calculated, add an element to the
# par5 with the key that equals to the calculated value + offset
# (if offset is 0, then "2,5-7" becomes 2,5,6,7; if offset is -1,
# min is 1, and max is 12, then "2,5-7,11-" becomes 1,4,5,6,10,11).
# Before adding elements to par5, its previous content is erased.
# If par1 is a list specified incorrectly, return value is 0,
# otherwise 1 is returned
sub eval_timelist {
my($spec) = $_[0];
my($min) = $_[1];
my($max) = $_[2];
my($offset) = $_[3];
my($ref) = $_[4];
my(@parts, $part);
my($pos, $range1, $range2);
my($i, $j);
# split time specification into parts (by comma) and look what
# ranges or individual numbers every part defines
@parts = split(/,/, $spec);
if (!scalar(@parts)) { return 0; }
%{$ref} = ();
foreach $part (@parts) {
# if part is empty, skip it and take the next part
if (!length($part)) { next; }
# if part equals to '*', assume that it defines the range min..max
if ($part eq "*") {
# add offset (this also forces numeric context, so "05" becomes "5")
# and save values to the hash
$i = $min + $offset;
$j = $max + $offset;
while ($i <= $j) { $ref->{$i++} = 1; }
next;
}
# if part is not empty and not '*', check if it contains '-'
$pos = index($part, "-");
if ($pos == -1) {
# if part does not contain '-', assume it defines a single number
if (!is_uinteger($part)) { return 0; }
if ($part < $min || $part > $max) { return 0; }
# add offset (this also forces numeric context, so "05" becomes "5")
# and save value to the hash
$part += $offset;
$ref->{$part} = 1;
} else {
# if part does contain '-', assume it defines a range
$range1 = substr($part, 0, $pos);
$range2 = substr($part, $pos + 1);
# if left side of the range is missing, assume minimum for the value;
# if right side of the range is missing, assume maximum for the value;
# offset is then added to the left and right side of the range
# (this also forces numeric context, so "05" becomes "5")
if (length($range1)) {
if (!is_uinteger($range1)) { return 0; }
if ($range1 < $min || $range1 > $max) { return 0; }
$i = $range1 + $offset;
} else { $i = $min + $offset; }
if (length($range2)) {
if (!is_uinteger($range2)) { return 0; }
if ($range2 < $min || $range2 > $max) { return 0; }
$j = $range2 + $offset;
} else { $j = $max + $offset; }
# save values to the hash
while ($i <= $j) { $ref->{$i++} = 1; }
}
}
return 1;
}
# Parameters: par1 - time specification
# par2..par6 - references to the hashes of minutes, hours,
# days, months and weekdays
# par7 - the name of the configuration file
# par8 - line number in configuration file
# Action: par1 will be split to parts, every part is analyzed and
# results are saved into hashes par2..par6.
# Previous content of the hashes is erased. If errors
# are found when analyzing par1, 0 is returned, otherwise 1
# will be return value.
sub analyze_timespec {
my($timespec) = $_[0];
my($minref) = $_[1];
my($hourref) = $_[2];
my($dayref) = $_[3];
my($monthref) = $_[4];
my($wdayref) = $_[5];
my($conffile) = $_[6];
my($lineno) = $_[7];
my(@parts);
@parts = split(' ', $timespec);
if (scalar(@parts) != 5) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Wrong number of elements in time specification");
return 0;
}
# evaluate minute specification (range 0..59, offset 0)
if (!eval_timelist($parts[0], 0, 59, 0, $minref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid minute specification '$parts[0]'");
return 0;
}
# evaluate hour specification (range 0..23, offset 0)
if (!eval_timelist($parts[1], 0, 23, 0, $hourref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid hour specification '$parts[1]'");
return 0;
}
# evaluate day specification (range 0..31, offset 0)
# 0 denotes the last day of a month
if (!eval_timelist($parts[2], 0, 31, 0, $dayref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid day specification '$parts[2]'");
return 0;
}
# evaluate month specification (range 1..12, offset -1)
if (!eval_timelist($parts[3], 1, 12, -1, $monthref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid month specification '$parts[3]'");
return 0;
}
# evaluate weekday specification (range 0..7, offset 0)
if (!eval_timelist($parts[4], 0, 7, 0, $wdayref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid weekday specification '$parts[4]'");
return 0;
}
# if 7 was specified as a weekday, also define 0,
# since perl uses only 0 for Sunday
if (exists($wdayref->{"7"})) { $wdayref->{"0"} = 1; }
return 1;
}
# Parameters: par1 - reference to a hash containing the rule
# par2 - list of required keywords for the rule
# par3 - the type of the rule
# par4 - the name of the configuration file
# par5 - line number in configuration file the rule begins at
# Action: check if all required keywords are present in the rule par1 and
# return 0 if they are, otherwise return 1.
sub missing_keywords {
my($ref) = $_[0];
my($keylist) = $_[1];
my($type) = $_[2];
my($conffile) = $_[3];
my($lineno) = $_[4];
my($key, $error);
$error = 0;
foreach $key (@{$keylist}) {
if (!exists($ref->{$key})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Keyword '$key' missing (needed for the rule type $type)");
$error = 1;
}
}
return $error;
}
# Parameters: par1 - reference to a hash containing the rule
# par2 - name of the configuration file
# par3 - line number in configuration file the rule begins at
# par4 - rule ID
# Action: check the rule par1 for correctness and save it to
# global array $configuration{par2} if it is well-defined;
# if the rule was correctly defined, return 1, otherwise return 0
sub check_rule {
my($ref) = $_[0];
my($conffile) = $_[1];
my($lineno) = $_[2];
my($number) = $_[3];
my($config, @keywords);
my($type, $progname);
my($whatnext, $pattype, $patlines, $pattern, $contpreeval);
my($whatnext2, $pattype2, $patlines2, $pattern2, $contpreeval2);
my(@context, @action, @context2, @action2);
my(%minutes, %hours, %days, %months, %weekdays);
$config = $configuration{$conffile};
if (!exists($ref->{"type"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Keyword 'type' missing");
return 0;
}
$type = uc($ref->{"type"});
# ------------------------------------------------------------
# SINGLE rule
# ------------------------------------------------------------
if ($type eq "SINGLE") {
@keywords = ("ptype", "pattern", "desc", "action");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
$config->[$number] = { "ID" => $number,
"Type" => SINGLE,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_SCRIPT rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHSCRIPT") {
@keywords = ("ptype", "pattern", "script", "desc", "action");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
$progname = (split(' ', $ref->{"script"}))[0];
if (! -f $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - could not find '$progname'");
} elsif (! -x $progname) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Warning - '$progname' is not executable");
}
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (exists($ref->{"action2"})) {
if (!analyze_actionlist($ref->{"action2"}, \@action2,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
} else { @action2 = (); }
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
$config->[$number] = { "ID" => $number,
"Type" => SINGLE_W_SCRIPT,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Script" => $ref->{"script"},
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"Action2" => [ @action2 ],
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_SUPPRESS rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHSUPPRESS") {
@keywords = ("ptype", "pattern", "desc", "action", "window");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
$config->[$number] = { "ID" => $number,
"Type" => SINGLE_W_SUPPRESS,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"Window" => $ref->{"window"},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# PAIR rule
# ------------------------------------------------------------
elsif ($type eq "PAIR") {
@keywords = ("ptype", "pattern", "desc", "action",
"ptype2", "pattern2", "desc2", "action2");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (!exists($ref->{"continue2"})) { $whatnext2 = DONTCONT; }
else {
$whatnext2 = analyze_continue($ref->{"continue2"}, $conffile, $lineno);
}
if ($whatnext2 == INVALIDVALUE) { return 0; }
($pattype2, $patlines2, $pattern2) =
analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
$conffile, $lineno, $pattype);
if ($pattype2 == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action2"}, \@action2,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (!exists($ref->{"window"})) { $ref->{"window"} = 0; }
elsif (!is_uinteger($ref->{"window"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
if (exists($ref->{"context2"})) {
$contpreeval2 = check_context_preeval($ref->{"context2"});
if (!analyze_context($ref->{"context2"}, \@context2)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd context specification '", $ref->{"context2"}, "'");
return 0;
}
} else { @context2 = (); $contpreeval2 = 0; }
$config->[$number] = { "ID" => $number,
"Type" => PAIR,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"WhatNext2" => $whatnext2,
"PatType2" => $pattype2,
"Pattern2" => $pattern2,
"PatLines2" => $patlines2,
"Context2" => [ @context2 ],
"ContPreEval2" => $contpreeval2,
"Desc2" => $ref->{"desc2"},
"Action2" => [ @action2 ],
"Window" => $ref->{"window"},
"Operations" => {},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# PAIR_W_WINDOW rule
# ------------------------------------------------------------
elsif ($type eq "PAIRWITHWINDOW") {
@keywords = ("ptype", "pattern", "desc", "action",
"ptype2", "pattern2", "desc2", "action2", "window");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (!exists($ref->{"continue2"})) { $whatnext2 = DONTCONT; }
else {
$whatnext2 = analyze_continue($ref->{"continue2"}, $conffile, $lineno);
}
if ($whatnext2 == INVALIDVALUE) { return 0; }
($pattype2, $patlines2, $pattern2) =
analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
$conffile, $lineno, $pattype);
if ($pattype2 == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action2"}, \@action2,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
if (exists($ref->{"context2"})) {
$contpreeval2 = check_context_preeval($ref->{"context2"});
if (!analyze_context($ref->{"context2"}, \@context2)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd context specification '", $ref->{"context2"}, "'");
return 0;
}
} else { @context2 = (); $contpreeval2 = 0; }
$config->[$number] = { "ID" => $number,
"Type" => PAIR_W_WINDOW,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"WhatNext2" => $whatnext2,
"PatType2" => $pattype2,
"Pattern2" => $pattern2,
"PatLines2" => $patlines2,
"Context2" => [ @context2 ],
"ContPreEval2" => $contpreeval2,
"Desc2" => $ref->{"desc2"},
"Action2" => [ @action2 ],
"Window" => $ref->{"window"},
"Operations" => {},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_THRESHOLD rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHTHRESHOLD") {
@keywords = ("ptype", "pattern",
"desc", "action", "window", "thresh");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (exists($ref->{"action2"})) {
if (!analyze_actionlist($ref->{"action2"}, \@action2,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
} else { @action2 = (); }
if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
}
if (!is_uinteger($ref->{"thresh"}) || $ref->{"thresh"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid threshold '", $ref->{"thresh"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
$config->[$number] = { "ID" => $number,
"Type" => SINGLE_W_THRESHOLD,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"Action2" => [ @action2 ],
"Window" => $ref->{"window"},
"Threshold" => $ref->{"thresh"},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_2_THRESHOLDS rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITH2THRESHOLDS") {
@keywords = ("ptype", "pattern",
"desc", "action", "window", "thresh",
"desc2", "action2", "window2", "thresh2");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; }
else {
$whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno);
}
if ($whatnext == INVALIDVALUE) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st time window '", $ref->{"window"}, "'");
return 0;
}
if (!is_uinteger($ref->{"thresh"}) || $ref->{"thresh"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st threshold '", $ref->{"thresh"}, "'");
return 0;
}
if (!analyze_actionlist($ref->{"action2"}, \@action2,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (!is_uinteger($ref->{"window2"}) || $ref->{"window2"} == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd time window '", $ref->{"window2"}, "'");
return 0;
}
if (!is_uinteger($ref->{"thresh2"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd threshold '", $ref->{"thresh2"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
$config->[$number] = { "ID" => $number,
"Type" => SINGLE_W_2_THRESHOLDS,
"WhatNext" => $whatnext,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"Window" => $ref->{"window"},
"Threshold" => $ref->{"thresh"},
"Desc2" => $ref->{"desc2"},
"Action2" => [ @action2 ],
"Window2" => $ref->{"window2"},
"Threshold2" => $ref->{"thresh2"},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# SUPPRESS rule
# ------------------------------------------------------------
elsif ($type eq "SUPPRESS") {
@keywords = ("ptype", "pattern");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
($pattype, $patlines, $pattern) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($pattype == INVALIDVALUE) { return 0; }
if (exists($ref->{"context"})) {
$contpreeval = check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); $contpreeval = 0; }
if (!exists($ref->{"desc"})) {
if ($pattype == REGEXP || $pattype == SUBSTR
|| $pattype == PERLFUNC) {
$ref->{"desc"} = "Suppress rule with pattern: $pattern";
} elsif ($pattype == NREGEXP || $pattype == NSUBSTR
|| $pattype == NPERLFUNC) {
$ref->{"desc"} = "Suppress rule with negative pattern: $pattern";
} else {
$ref->{"desc"} =
"Suppress rule with pattern: " . ($pattern?"TRUE":"FALSE");
}
}
$config->[$number] = { "ID" => $number,
"Type" => SUPPRESS,
"PatType" => $pattype,
"Pattern" => $pattern,
"PatLines" => $patlines,
"Context" => [ @context ],
"ContPreEval" => $contpreeval,
"Desc" => $ref->{"desc"},
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# CALENDAR rule
# ------------------------------------------------------------
elsif ($type eq "CALENDAR") {
@keywords = ("time", "desc", "action");
if (missing_keywords($ref, \@keywords, $type,
$conffile, $lineno)) { return 0; }
if (!analyze_timespec($ref->{"time"}, \%minutes, \%hours, \%days,
\%months, \%weekdays, $conffile, $lineno)) { return 0; }
if (!analyze_actionlist($ref->{"action"}, \@action,
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (exists($ref->{"context"})) {
# since for Calendar rule []-operator has no meaning,
# just remove [] brackets if they exist
check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, \@context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context specification '", $ref->{"context"}, "'");
return 0;
}
} else { @context = (); }
$config->[$number] = { "ID" => $number,
"Type" => CALENDAR,
"Minutes" => { %minutes },
"Hours" => { %hours },
"Days" => { %days },
"Months" => { %months },
"Weekdays" => { %weekdays },
"LastMinute" => 0,
"LastHour" => 0,
"LastDay" => 0,
"LastMonth" => 0,
"LastWeekday" => 0,
"Context" => [ @context ],
"Desc" => $ref->{"desc"},
"Action" => [ @action ],
"MatchCount" => 0,
"LineNo" => $lineno };
return 1;
}
# ------------------------------------------------------------
# end of rule processing
# ------------------------------------------------------------
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid rule type $type");
return 0;
}
# Parameters: par1 - name of the configuration file
# Action: read in rules from configuration file par1 and call
# check_rule() for every rule; if all rules in the file
# were correctly defined, return 1, otherwise return 0
sub read_configfile {
my($conffile) = $_[0];
my($linebuf, $line, $i, $cont, $rulestart);
my($keyword, $value, $file_status);
my(%rule);
$file_status = 1; # start with the assumption that all rules
# are correctly defined
log_msg(LOG_NOTICE, "Reading configuration from $conffile");
if (!open(CONFFILE, "$conffile")) {
log_msg(LOG_ERR, "Can't open configuration file $conffile ($!)");
return 0;
}
$i = 0;
$cont = 0;
%rule = ();
$rulestart = 1;
for (;;) {
# read next line from file
$linebuf = <CONFFILE>;
# check if the line belongs to previous line; if it does, form a
# single line from them and start the loop again (i.e. we will
# concatenate lines until we read a line that does not end with '\')
if (defined($linebuf)) {
chomp($linebuf);
if ($cont) { $line .= $linebuf; } else { $line = $linebuf; }
# remove whitespaces from line beginnings and ends;
# if line is all-whitespace, set it to empty string
if ($line =~ /^\s*(.*\S)/) { $line = $1; } else { $line = ""; }
# check if line ends with '\'; if it does, remove '\', set $cont
# to 1 and jump at the start of loop to read next line, otherwise
# set $cont to 0
if (substr($line, length($line) - 1) eq '\\') {
chop($line);
$cont = 1;
next;
} else {
$cont = 0;
}
}
# if the line constructed during previous loop is empty, starting
# with #-symbol, or if we have reached EOF, consider that as the end
# of current rule. Check the rule and set $rulestart to the next line.
# If we have reached EOF, quit the loop, otherwise take the next line.
if (!defined($linebuf) || !length($line)
|| index($line, '#') == 0) {
if (scalar(%rule)) {
if (check_rule(\%rule, $conffile, $rulestart, $i)) { ++$i; }
else { $file_status = 0; }
%rule = ();
}
$rulestart = $. + 1;
if (defined($linebuf)) { next; } else { last; }
}
# split line into keyword and value
if ($line =~ /^\s*([A-Za-z0-9]+)\s*=\s*(.*\S)/) {
$keyword = $1;
$value = $2;
} else {
log_msg(LOG_ERR, "$conffile line $. ($line):",
"Line not in keyword=value format or non-alphanumeric keyword");
$file_status = 0;
next;
}
# check if the keyword is valid and save it to hash %rule if it is
if (!exists(CONFIG_KEYWORDS->{$keyword})) {
log_msg(LOG_ERR, "$conffile line $.:", "Invalid keyword $keyword");
$file_status = 0;
next;
}
$rule{$keyword} = $value;
}
if (!$i) {
log_msg(LOG_WARN, "No valid rules found in configuration file $conffile");
} else {
log_msg(LOG_DEBUG, "$i rules loaded from $conffile");
}
close(CONFFILE);
return $file_status;
}
# Parameters: -
# Action: evaluate the conffile patterns given in commandline, form the
# list of configuration files and save it to global array
# @conffiles, and read in rules from the configuration files
sub read_config {
my($pattern, $conffile, $ret);
my(@stat, @rules);
# Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
# @calendar and @conffiles (the keys for %configuration, %config_ltimes
# and %config_mtimes are members of the global array @conffiles), and set
# the $lastconfigload variable to reflect the current time
$lastconfigload = time();
%configuration = ();
%config_ltimes = ();
%config_mtimes = ();
@calendar = ();
@conffiles = ();
# Form the list of configuration files and save it to a global array
foreach $pattern (@conffilepat) { push @conffiles, glob($pattern); }
# Read the configuration from rule files and store it to the global
# array %configuration; also, store mtimes of rule files to the global
# array %config_mtimes and Calendar rules to the global array @calendar
$ret = 1;
foreach $conffile (@conffiles) {
$configuration{$conffile} = [];
$config_ltimes{$conffile} = $lastconfigload;
@stat = stat($conffile);
$config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0;
if (!read_configfile($conffile)) { $ret = 0; }
@rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
push @calendar, @rules;
}
return $ret;
}
# Parameters: par1 - reference to an array where the names of modified
# and removed configuration files will be stored
# Action: evaluate the conffile patterns given in commandline, form the
# list of configuration files and save it to global array
# @conffiles; read in rules from the configuration files that are
# either new or have been modified since the last configuration
# load; also store to the array par1 the names of configuration
# files that have been modified or removed since the last
# configuration load.
sub soft_read_config {
my($file_list) = $_[0];
my($pattern, $conffile);
my(%old_config, %old_ltimes, %old_mtimes);
my(@old_conffiles, @stat, @rules);
# Back up global arrays %configuration, %config_ltimes, %config_mtimes,
# and @conffiles
%old_config = %configuration;
%old_ltimes = %config_ltimes;
%old_mtimes = %config_mtimes;
@old_conffiles = @conffiles;
# Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
# @calendar and @conffiles (the keys for %configuration, %config_ltimes
# and %config_mtimes are members of the global array @conffiles), and set
# the $lastconfigload variable to reflect the current time
$lastconfigload = time();
%configuration = ();
%config_ltimes = ();
%config_mtimes = ();
@calendar = ();
@conffiles = ();
# Form the list of configuration files and save it to a global array
foreach $pattern (@conffilepat) { push @conffiles, glob($pattern); }
# Read the configuration from the rule files that are new or have been
# modified and store it to the global array %configuration; store mtimes
# of rule files to the global array %config_mtimes; store file load times
# to the global array %config_ltimes; store Calendar rules to the global
# array @calendar; also, store the names of modified configuration files
# to the array par1
@{$file_list} = ();
foreach $conffile (@conffiles) {
@stat = stat($conffile);
$config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0;
if (!exists($old_config{$conffile})) {
$configuration{$conffile} = [];
read_configfile($conffile);
$config_ltimes{$conffile} = $lastconfigload;
} elsif ($old_mtimes{$conffile} != $config_mtimes{$conffile}) {
$configuration{$conffile} = [];
read_configfile($conffile);
$config_ltimes{$conffile} = $lastconfigload;
push @{$file_list}, $conffile;
} else {
$configuration{$conffile} = $old_config{$conffile};
$config_ltimes{$conffile} = $old_ltimes{$conffile};
}
@rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
push @calendar, @rules;
}
# store the names of removed configuration files to the array par1
push @{$file_list}, grep(!exists($configuration{$_}), @old_conffiles);
}
################################################
# Functions related to execution of action lists
################################################
# Parameters: par1 - string
# par2 - string
# Action: all %-variables in string par1 will be replaced with their values
sub substitute_var {
if (index($_[0], "%") == -1) { return; }
$variables{"u"} = time();
$variables{"t"} = localtime($variables{"u"});
$variables{"s"} = $_[1];
$variables{"%"} = "%";
# variable will not be substituted if it doesn't exist or its value is undef
$_[0] =~ s/(\%\{([A-Za-z][A-Za-z0-9_]*)\}|
\%([A-Za-z][A-Za-z0-9_]*|\%))/
defined($variables{$+})?$variables{$+}:$1/egx;
}
# Parameters: par1 - shell command
# par2 - 'collect output' flag
# Action: par1 will be executed as a shell command in a child
# process. After process has been created, subroutine creates an
# entry in the %children hash, and returns the pid of the child
# process. If process creation failed, undef is returned. After the
# command has completed, the child process terminates and returns
# command's exit code as its own exit value.
# If par2 is defined and non-zero, command's standard output is
# returned to the main process through a pipe.
sub shell_cmd {
my($cmd) = $_[0];
my($collect_output) = $_[1];
my($pid);
local *READ_FH; # we need to use 'local *', since each time we enter
# this procedure a new filehandle must be created that
# will be returned from this procedure for external use
# set up a pipe before calling fork()
if ($collect_output && !pipe(READ_FH, WRITE_FH)) {
log_msg(LOG_ERR, "Could not create pipe for command '$cmd' ($!)");
return undef;
}
# try to create a child process and return undef, if fork failed;
# if fork was successful and we are in parent process, return the
# pid of the child process
$pid = fork();
if (!defined($pid)) {
if ($collect_output) {
close(READ_FH);
close(WRITE_FH);
}
log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)");
return undef;
} elsif ($pid) {
$children{$pid} = { "cmd" => $cmd,
"fh" => undef,
"open" => 0,
"buffer" => "",
"Desc" => undef,
"Action" => undef,
"Action2" => undef };
if ($collect_output) {
close(WRITE_FH);
$children{$pid}->{"fh"} = *READ_FH;
$children{$pid}->{"open"} = 1;
}
log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'");
return $pid;
}
# we are in the child process now...
if ($collect_output) {
# connect the standard output of the child process to the pipe
# and make the standard output unbuffered
close(READ_FH);
if (!open(STDOUT, ">&WRITE_FH")) { exit(1); }
select(STDOUT);
$| = 1;
close(WRITE_FH);
}
# if we have received SIGTERM, exit
if ($terminate) { exit(0); }
# execute the command inside the child process; if exec() fails, exit
exec("$cmd");
exit(1);
}
# Parameters: par1 - shell command for reporting
# par2 - reference to a hash or an array
# Action: par1 will be executed as a shell command in a child process, and
# contents of array par2 (or keys of hash par2) are fed to its
# standard input. After process has been created, subroutine creates
# an entry in the %children hash, and returns the pid of the child
# process. If process creation failed, undef is returned.
# After the command has completed, the child process
# terminates and returns command's exit code as its own exit value.
sub pipe_cmd {
my($cmd) = $_[0];
my($ref) = $_[1];
my($pid, $elem);
# try to create a child process and return undef, if fork failed;
# if fork was successful and we are in parent process, return the
# pid of the child process
$pid = fork();
if (!defined($pid)) {
log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)");
return undef;
} elsif ($pid) {
$children{$pid} = { "cmd" => $cmd,
"fh" => undef,
"open" => 0,
"buffer" => "",
"Desc" => undef,
"Action" => undef,
"Action2" => undef };
log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'");
return $pid;
}
# we are in the child process now...
# if we have received SIGTERM, exit; otherwise fork the command
if ($terminate) { exit(0); } else { $pid = open(CMDPIPE, "| $cmd"); }
if (defined($pid)) {
# if the main SEC process has sent us SIGTERM meanwhile, send SIGTERM
# to the command and exit; otherwise set the signal handler for SIGTERM
if ($terminate) {
kill('TERM', $pid);
exit(0);
} else {
$SIG{TERM} = sub { kill('TERM', $pid); exit(0); };
}
# ignore SIGPIPE if the command has died or has closed the pipe
$SIG{PIPE} = 'IGNORE';
# write data to pipe
select CMDPIPE;
$| = 1;
if (ref($ref) eq "HASH") {
while ($elem = each(%{$ref})) { print CMDPIPE $elem, "\n"; }
} else {
foreach $elem (@{$ref}) { print CMDPIPE $elem, "\n"; }
}
# In some perl versions the close() function is buggy, and although
# SIGPIPE is ignored, close() still sets $? variable to signal an
# error, if the forked command does not read its stdin. To overcome
# this problem, IO::Handle->flush() must be called before close(),
# since this forces the close() function to set $? correctly
CMDPIPE->flush();
# note that close() does not return until the command has completed
close(CMDPIPE);
exit($? >> 8);
}
exit(1);
}
# Parameters: par1 - reference to a list of actions
# par2 - event description text
# Action: execute actions in a given action list
sub execute_actionlist {
my($actionlist) = $_[0];
my($text) = $_[1];
my($text2, $i, $j, $nbytes);
my($file, $cmdline, $context, $lifetime, $list);
my($createafter, $conffile, $ruleid);
my($event, @event, $alias, @aliases, @params);
my($variable, $value, $code, @retval, $evalok);
my($key, $ref);
$i = 0;
$j = scalar(@{$actionlist});
while ($i < $j) {
if ($actionlist->[$i] == NONE) { ++$i; }
elsif ($actionlist->[$i] == LOGONLY) {
$event = $actionlist->[$i+1];
substitute_var($event, $text);
log_msg(LOG_NOTICE, $event);
$i += 2;
}
elsif ($actionlist->[$i] == WRITE) {
$file = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_var($file, $text);
substitute_var($event, $text);
log_msg(LOG_DEBUG, "Writing event '$event' to file $file");
if ($file eq "-") {
select(STDOUT);
$| = 1;
print STDOUT "$event\n";
} elsif (-e $file && ! -f $file && ! -p $file) {
log_msg(LOG_WARN, "Can't write event '$event' to file $file!",
"(not a regular file or pipe)");
} elsif (-p $file) {
if (sysopen(WRITEFILE, $file, O_WRONLY | O_NONBLOCK)) {
$nbytes = syswrite(WRITEFILE, "$event\n");
close(WRITEFILE);
if (!defined($nbytes) || $nbytes != length($event) + 1) {
log_msg(LOG_WARN,
"Error when writing event '$event' to pipe $file!");
}
} else {
log_msg(LOG_WARN,
"Can't open pipe $file for writing event '$event'!");
}
} else {
if (open(WRITEFILE, ">>$file")) {
print WRITEFILE "$event\n";
close(WRITEFILE);
} else {
log_msg(LOG_WARN,
"Can't open file $file for writing event '$event'!");
}
}
$i += 3;
}
elsif ($actionlist->[$i] == SHELLCOMMAND) {
$cmdline = $actionlist->[$i+1];
$text2 = $text;
# if -quoting flag was specified, mask apostrophes in $text2
# and put $text2 inside apostrophes
if ($quoting) {
$text2 =~ s/'/'\\''/g;
$text2 = "'" . $text2 . "'";
}
substitute_var($cmdline, $text2);
log_msg(LOG_INFO, "Executing shell command '$cmdline'");
shell_cmd($cmdline);
$i += 2;
}
elsif ($actionlist->[$i] == SPAWN) {
$cmdline = $actionlist->[$i+1];
$text2 = $text;
# if -quoting flag was specified, mask apostrophes in $text2
# and put $text2 inside apostrophes
if ($quoting) {
$text2 =~ s/'/'\\''/g;
$text2 = "'" . $text2 . "'";
}
substitute_var($cmdline, $text2);
log_msg(LOG_INFO, "Spawning shell command '$cmdline'");
shell_cmd($cmdline, 1);
$i += 2;
}
elsif ($actionlist->[$i] == PIPE) {
$event = $actionlist->[$i+1];
$cmdline = $actionlist->[$i+2];
substitute_var($event, $text);
substitute_var($cmdline, $text);
log_msg(LOG_INFO, "Feeding event '$event' to shell command '$cmdline'");
if (length($cmdline)) {
pipe_cmd($cmdline, [ $event ]);
} else {
select(STDOUT);
$| = 1;
print STDOUT "$event\n";
}
$i += 3;
}
elsif ($actionlist->[$i] == CREATECONTEXT) {
$context = $actionlist->[$i+1];
$lifetime = $actionlist->[$i+2];
$list = $actionlist->[$i+3];
substitute_var($context, $text);
log_msg(LOG_DEBUG, "Creating context '$context'");
if (exists($context_list{$context})) {
$context_list{$context}->{"Time"} = time();
$context_list{$context}->{"Window"} = $lifetime;
$context_list{$context}->{"Buffer"} = [];
$context_list{$context}->{"Action"} = $list;
$context_list{$context}->{"Desc"} = $text;
} else {
$context_list{$context} = { "Time" => time(),
"Window" => $lifetime,
"Buffer" => [],
"Action" => $list,
"Desc" => $text,
"Aliases" => [ $context ] };
}
$i += 4;
}
elsif ($actionlist->[$i] == DELETECONTEXT) {
$context = $actionlist->[$i+1];
substitute_var($context, $text);
log_msg(LOG_DEBUG, "Deleting context '$context'");
if (exists($context_list{$context}) &&
!exists($context_list{$context}->{"DeleteInProgress"})) {
@aliases = @{$context_list{$context}->{"Aliases"}};
foreach $alias (@aliases) {
delete $context_list{$alias};
log_msg(LOG_DEBUG, "Context '$alias' deleted");
}
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist or is going through deletion, can't delete");
}
$i += 2;
}
elsif ($actionlist->[$i] == OBSOLETECONTEXT) {
$context = $actionlist->[$i+1];
substitute_var($context, $text);
log_msg(LOG_DEBUG, "Obsoleting context '$context'");
if (exists($context_list{$context}) &&
!exists($context_list{$context}->{"DeleteInProgress"})) {
$context_list{$context}->{"Window"} = -1;
valid_context($context);
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist or is going through deletion, can't obsolete");
}
$i += 2;
}
elsif ($actionlist->[$i] == SETCONTEXT) {
$context = $actionlist->[$i+1];
$lifetime = $actionlist->[$i+2];
$list = $actionlist->[$i+3];
substitute_var($context, $text);
log_msg(LOG_DEBUG, "Changing settings for context '$context'");
if (exists($context_list{$context})) {
$context_list{$context}->{"Time"} = time();
$context_list{$context}->{"Window"} = $lifetime;
$context_list{$context}->{"Action"} = $list;
$context_list{$context}->{"Desc"} = $text;
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't change settings");
}
$i += 4;
}
elsif ($actionlist->[$i] == ALIAS) {
$context = $actionlist->[$i+1];
$alias = $actionlist->[$i+2];
substitute_var($context, $text);
substitute_var($alias, $text);
log_msg(LOG_DEBUG, "Creating alias '$alias' for context '$context'");
if (!exists($context_list{$context})) {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't create alias");
} elsif (exists($context_list{$alias})) {
log_msg(LOG_WARN, "Alias '$alias' already exists");
} else {
push @{$context_list{$context}->{"Aliases"}}, $alias;
$context_list{$alias} = $context_list{$context};
}
$i += 3;
}
elsif ($actionlist->[$i] == UNALIAS) {
$alias = $actionlist->[$i+1];
substitute_var($alias, $text);
log_msg(LOG_DEBUG, "Removing alias '$alias'");
if (exists($context_list{$alias}) &&
!exists($context_list{$alias}->{"DeleteInProgress"})) {
@aliases = grep($_ ne $alias, @{$context_list{$alias}->{"Aliases"}});
if (scalar(@aliases)) {
$context_list{$alias}->{"Aliases"} = [ @aliases ];
} else {
log_msg(LOG_DEBUG,
"Alias '$alias' was the last reference to a context");
}
delete $context_list{$alias};
} else {
log_msg(LOG_WARN,
"Alias '$alias' does not exist or its context is going through deletion, can't remove");
}
$i += 2;
}
elsif ($actionlist->[$i] == ADD) {
$context = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_var($context, $text);
substitute_var($event, $text);
log_msg(LOG_DEBUG, "Adding event '$event' to context '$context'");
if (!exists($context_list{$context})) {
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "",
"Aliases" => [ $context ] };
}
@event = split(/\n/, $event);
if (!$evstoresize || scalar(@{$context_list{$context}->{"Buffer"}})
+ scalar(@event) <= $evstoresize) {
push @{$context_list{$context}->{"Buffer"}}, @event;
} else {
log_msg(LOG_WARN,
"Can't add event '$event' to context '$context', store full");
}
$i += 3;
}
elsif ($actionlist->[$i] == FILL) {
$context = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_var($context, $text);
substitute_var($event, $text);
log_msg(LOG_DEBUG, "Filling context '$context' with event '$event'");
if (!exists($context_list{$context})) {
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "",
"Aliases" => [ $context ] };
}
@event = split(/\n/, $event);
if (!$evstoresize || scalar(@event) <= $evstoresize) {
$context_list{$context}->{"Buffer"} = [ @event ];
} else {
log_msg(LOG_WARN,
"Can't fill context '$context' with event '$event', store full");
}
$i += 3;
}
elsif ($actionlist->[$i] == REPORT) {
$context = $actionlist->[$i+1];
$cmdline = $actionlist->[$i+2];
substitute_var($context, $text);
substitute_var($cmdline, $text);
log_msg(LOG_INFO,
"Reporting the event store of context '$context' through shell command '$cmdline'");
if (!exists($context_list{$context})) {
log_msg(LOG_WARN, "Context '$context' does not exist, can't report");
} elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) {
log_msg(LOG_WARN,
"Event store of context '$context' is empty, can't report");
} else {
if (length($cmdline)) {
pipe_cmd($cmdline, $context_list{$context}->{"Buffer"});
} else {
select(STDOUT);
$| = 1;
foreach $event (@{$context_list{$context}->{"Buffer"}}) {
print STDOUT "$event\n";
}
}
}
$i += 3;
}
elsif ($actionlist->[$i] == COPYCONTEXT) {
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_var($context, $text);
log_msg(LOG_DEBUG,
"Copying context '$context' to variable '%$variable'");
if (exists($context_list{$context})) {
$value = join("\n", @{$context_list{$context}->{"Buffer"}});
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't copy");
}
$i += 3;
}
elsif ($actionlist->[$i] == EMPTYCONTEXT) {
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_var($context, $text);
log_msg(LOG_DEBUG, "Emptying the event store of context '$context'");
if (exists($context_list{$context})) {
if (length($variable)) {
$value = join("\n", @{$context_list{$context}->{"Buffer"}});
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
}
$context_list{$context}->{"Buffer"} = [];
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't empty");
}
$i += 3;
}
elsif ($actionlist->[$i] == EVENT) {
$createafter = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_var($event, $text);
@event = split(/\n/, $event);
if ($createafter) {
foreach $event (@event) {
push @pending_events, [ time() + $createafter, $event ];
}
} else {
log_msg(LOG_DEBUG, "Creating event '$event'");
push @events, @event;
}
$i += 3;
}
elsif ($actionlist->[$i] == RESET) {
$conffile = $actionlist->[$i+1];
$ruleid = $actionlist->[$i+2];
$event = $actionlist->[$i+3];
substitute_var($event, $text);
if (length($ruleid)) {
$key = gen_key($conffile, $ruleid, $event);
log_msg(LOG_DEBUG,
"Cancelling the correlation operation with key '$key'");
$ref = $configuration{$conffile}->[$ruleid];
if (exists($ref->{"Operations"})) {
delete $ref->{"Operations"}->{$key};
}
delete $corr_list{$key};
} else {
log_msg(LOG_DEBUG,
"Cancelling all correlation operations started by rules from",
$conffile, "to detect composite event '$event'");
foreach $ref (@{$configuration{$conffile}}) {
$key = gen_key($conffile, $ref->{"ID"}, $event);
if (exists($ref->{"Operations"})) {
delete $ref->{"Operations"}->{$key};
}
delete $corr_list{$key};
}
}
$i += 4;
}
elsif ($actionlist->[$i] == ASSIGN) {
$variable = $actionlist->[$i+1];
$value = $actionlist->[$i+2];
substitute_var($value, $text);
log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'");
$variables{$variable} = $value;
$i += 3;
}
elsif ($actionlist->[$i] == EVAL) {
$variable = $actionlist->[$i+1];
$code = $actionlist->[$i+2];
substitute_var($code, $text);
log_msg(LOG_DEBUG,
"Evaluating code '$code' and setting variable '%$variable'");
@retval = SEC::call_eval($code, 1);
$evalok = shift @retval;
foreach $value (@retval) { if (!defined($value)) { $value = ""; } }
if ($evalok) {
if (scalar(@retval) > 1) {
$value = join("\n", @retval);
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} elsif (scalar(@retval) == 1) {
$variables{$variable} = $retval[0];
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$retval[0]'");
} else {
log_msg(LOG_DEBUG, "No value received for variable '%$variable'");
}
} else {
log_msg(LOG_ERR, "Error evaluating code '$code':", $retval[0]);
}
$i += 3;
}
elsif ($actionlist->[$i] == CALL) {
$variable = $actionlist->[$i+1];
$code = $actionlist->[$i+2];
@params = @{$actionlist->[$i+3]};
log_msg(LOG_DEBUG,
"Calling code '%$code->()' and setting variable '%$variable'");
if (ref($variables{$code}) eq "CODE") {
foreach $value (@params) { substitute_var($value, $text); }
@retval = eval { $variables{$code}->(@params) };
foreach $value (@retval) { if (!defined($value)) { $value = ""; } }
if ($@) {
log_msg(LOG_ERR, "Code '%$code->()' runtime error:", $@);
} else {
if (scalar(@retval) > 1) {
$value = join("\n", @retval);
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} elsif (scalar(@retval) == 1) {
$variables{$variable} = $retval[0];
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$retval[0]'");
} else {
log_msg(LOG_DEBUG, "No value received for variable '%$variable'");
}
}
} else {
log_msg(LOG_WARN, "Variable '%$code' is not a code reference");
}
$i += 4;
}
}
}
#####################################################
# Functions related to processing of lists at runtime
#####################################################
# Parameters: par1 - context
# Action: check if context "par1" is valid at the moment and return 1
# if it is, otherwise return 0. If context "par1" is found to
# be stale but is still present in the context list, it will be
# removed from there, and if it has an action list, the action
# list will be executed.
sub valid_context {
my($context) = $_[0];
my($alias, @aliases);
if (exists($context_list{$context})) {
# if the context has infinite lifetime or if its lifetime is not
# exceeded, it is valid (TRUE) and return 1
if (!$context_list{$context}->{"Window"}) { return 1; }
if (time() - $context_list{$context}->{"Time"}
<= $context_list{$context}->{"Window"}) { return 1; }
# if the deletion of the context is already in progress (a previous
# invocation of valid_context(CONTEXT) has called execute_actionlist()
# for the context CONTEXT, which has called valid_context(CONTEXT)
# again), then don't call execute_actionlist() for the second time
# but return 0 instead.
if (exists($context_list{$context}->{"DeleteInProgress"})) { return 0; }
# if the context is stale and its action-list-on-delete has not been
# executed yet, execute it now
log_msg(LOG_DEBUG, "Deleting stale context '$context'");
# execute action-list-on-delete
if (scalar(@{$context_list{$context}->{"Action"}})) {
$context_list{$context}->{"DeleteInProgress"} = 1;
execute_actionlist($context_list{$context}->{"Action"},
$context_list{$context}->{"Desc"});
}
# remove all names of the context from the list of contexts
@aliases = @{$context_list{$context}->{"Aliases"}};
foreach $alias (@aliases) {
delete $context_list{$alias};
log_msg(LOG_DEBUG, "Stale context '$alias' deleted");
}
}
return 0;
}
# Parameters: par1 - reference to a context formula
# Action: calculate the truth value of the context formula par1; return 1
# if it is TRUE, and return 0 if it is FALSE.
sub valid_formula {
my($ref) = $_[0];
my($i, $j, $left, @right);
my($evalresult, $evalok, $retval);
my($code, $func, $args);
$i = 0;
$j = scalar(@{$ref});
$left = undef;
@right = ();
while ($i < $j) {
if ($ref->[$i] == EXPRESSION) {
if (defined($left)) {
push @right, EXPRESSION;
push @right, $ref->[$i+1];
} else {
$left = valid_formula($ref->[$i+1]);
}
$i += 2;
}
elsif ($ref->[$i] == ECODE) {
if (defined($left)) {
push @right, ECODE;
push @right, $ref->[$i+1];
} else {
# if eval() for $code failed or returned false in boolean context
# (undef, "", or 0), set $left to 0, otherwise set $left to 1
$code = $ref->[$i+1];
($evalok, $evalresult) = SEC::call_eval($code, 0);
if (!$evalok) {
log_msg(LOG_ERR, "Error evaluating code '$code': $evalresult");
$left = 0;
} else {
$left = $evalresult?1:0;
}
}
$i += 2;
}
elsif ($ref->[$i] == CCODE) {
if (defined($left)) {
push @right, CCODE;
push @right, $ref->[$i+1];
push @right, $ref->[$i+2];
} else {
$args = $ref->[$i+1];
$func = $ref->[$i+2];
# don't call $func->($args), since the valid_formula() function
# could be called for the original context expression definition
# (e.g., if the rule type is Calendar or if the context expression
# is in []-brackets), and passing $args to the end user would allow
# the user to modify the original context definition
$retval = eval { $func->( ( @{$args} ) ) };
# if function call failed or returned false in boolean context
# (undef, "", or 0), set $left to 0, otherwise set $left to 1
if ($@) {
log_msg(LOG_ERR, "Context expression runtime error:", $@);
$left = 0;
} else {
$left = $retval?1:0;
}
}
$i += 3;
}
elsif ($ref->[$i] == OPERAND) {
if (defined($left)) {
push @right, OPERAND;
push @right, $ref->[$i+1];
} else {
$left = valid_context($ref->[$i+1]);
}
$i += 2;
}
elsif ($ref->[$i] == NEGATION) {
# if the second operand is present, negation belongs to it,
# otherwise negate the value of the first operand
if (scalar(@right)) {
push @right, NEGATION;
} else {
$left = $left?0:1;
}
++$i;
}
elsif ($ref->[$i] == AND) {
# the && operator has the short-circuiting capability and returns
# the value of the last evaluated operand which is either 0 or 1
$left = $left && valid_formula(\@right);
@right = ();
++$i;
}
elsif ($ref->[$i] == OR) {
# the || operator has the short-circuiting capability and returns
# the value of the last evaluated operand which is either 0 or 1
$left = $left || valid_formula(\@right);
@right = ();
++$i;
}
}
return $left;
}
# Parameters: par1 - number of lines that pattern was designed to match
# par2 - pattern (string type)
# Action: take par1 last lines from input buffer and concatenate them to
# form a single string. Check if par2 is a substring in the formed
# string (both par1 and par2 can contain newlines), and return 1
# if it is, otherwise return 0.
sub match_substr {
my($linecount) = $_[0];
my($substr) = $_[1];
my($line);
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
return (index($line, $substr) != -1);
}
# Parameters: par1 - number of lines that pattern was designed to match
# par2 - pattern (regular expression type)
# par3 - reference to an array, where backreference values
# $1, $2, .. will be saved. First element of an array will
# be $0 that equals to line(s) that were found matching
# Action: take par1 last lines from input buffer and concatenate them to
# form a single string. Match the formed string with regular
# expression par2, and if par2 contains bracketing constructs,
# save backreference values $1, $2, .. to array par3. If formed
# string matched regular expression, return 1, otherwise return 0
sub match_regexp {
my($linecount) = $_[0];
my($regexp) = $_[1];
my($subst_ref) = $_[2];
my($line);
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
if (@{$subst_ref} = ($line =~ /$regexp/)) {
unshift @{$subst_ref}, $line; # create $0 that equals to $line
return 1;
} else {
@{$subst_ref} = ( $line ); # create $0 that equals to $line
return 0;
}
}
# Parameters: par1 - number of lines that pattern was designed to match
# par2 - pattern (perl function type)
# par3 - reference to an array, where return values
# $1, $2, .. will be saved. First element of an array will
# be $0 that equals to line(s) that were found matching
# Action: take par1 last lines from input buffer with corresponding source
# names, and pass them to the perl function par2->().
# If the function returned value(s), save them as values $1, $2, ..
# to array par3. If function returned an empty list or returned
# a single value FALSE, return 0, otherwise return 1
sub match_perlfunc {
my($linecount) = $_[0];
my($codeptr) = $_[1];
my($subst_ref) = $_[2];
my($line, @lines, @sources);
my($size, $match);
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
@lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos];
@sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos];
@{$subst_ref} = eval { $codeptr->(@lines, @sources) };
if ($@) {
log_msg(LOG_ERR, "(N)PerlFunc pattern runtime error:", $@);
@{$subst_ref} = ();
}
$size = scalar(@{$subst_ref});
$match = $size > 1 || ($size == 1 && $subst_ref->[0]);
unshift @{$subst_ref}, $line; # create $0 that equals to $line
return $match;
}
# Parameters: par1 - reference to a source action list
# par2 - reference to a destination action list
# Action: action list par1 will be copied to par2
sub copy_actionlist {
my($src_ref) = $_[0];
my($dest_ref) = $_[1];
my($i, $j);
@{$dest_ref} = ();
$i = 0;
$j = scalar(@{$src_ref});
while ($i < $j) {
if ($src_ref->[$i] == NONE) {
push @{$dest_ref}, NONE;
++$i;
}
elsif ($src_ref->[$i] == LOGONLY) {
push @{$dest_ref}, LOGONLY;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == WRITE) {
push @{$dest_ref}, WRITE;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == SHELLCOMMAND) {
push @{$dest_ref}, SHELLCOMMAND;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == SPAWN) {
push @{$dest_ref}, SPAWN;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == PIPE) {
push @{$dest_ref}, PIPE;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == CREATECONTEXT) {
push @{$dest_ref}, CREATECONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
push @{$dest_ref}, [];
copy_actionlist($src_ref->[$i+3], $dest_ref->[$i+3]);
$i += 4;
}
elsif ($src_ref->[$i] == DELETECONTEXT) {
push @{$dest_ref}, DELETECONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == OBSOLETECONTEXT) {
push @{$dest_ref}, OBSOLETECONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == SETCONTEXT) {
push @{$dest_ref}, SETCONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
push @{$dest_ref}, [];
copy_actionlist($src_ref->[$i+3], $dest_ref->[$i+3]);
$i += 4;
}
elsif ($src_ref->[$i] == ALIAS) {
push @{$dest_ref}, ALIAS;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == UNALIAS) {
push @{$dest_ref}, UNALIAS;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == ADD) {
push @{$dest_ref}, ADD;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == FILL) {
push @{$dest_ref}, FILL;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == REPORT) {
push @{$dest_ref}, REPORT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == COPYCONTEXT) {
push @{$dest_ref}, COPYCONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == EMPTYCONTEXT) {
push @{$dest_ref}, EMPTYCONTEXT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == EVENT) {
push @{$dest_ref}, EVENT;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == RESET) {
push @{$dest_ref}, RESET;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
push @{$dest_ref}, $src_ref->[$i+3];
$i += 4;
}
elsif ($src_ref->[$i] == ASSIGN) {
push @{$dest_ref}, ASSIGN;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == EVAL) {
push @{$dest_ref}, EVAL;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == CALL) {
push @{$dest_ref}, CALL;
push @{$dest_ref}, $src_ref->[$i+1];
push @{$dest_ref}, $src_ref->[$i+2];
push @{$dest_ref}, [ @{$src_ref->[$i+3]} ];
$i += 4;
}
}
}
# Parameters: par1 - reference to a source context
# par2 - reference to a destination context
# Action: context par1 will be copied to par2
sub copy_context {
my($src_ref) = $_[0];
my($dest_ref) = $_[1];
my($i, $j);
@{$dest_ref} = ();
$i = 0;
$j = scalar(@{$src_ref});
while ($i < $j) {
if ($src_ref->[$i] == OPERAND) {
push @{$dest_ref}, OPERAND;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == EXPRESSION) {
push @{$dest_ref}, EXPRESSION;
push @{$dest_ref}, [];
copy_context($src_ref->[$i+1], $dest_ref->[$i+1]);
$i += 2;
}
elsif ($src_ref->[$i] == ECODE) {
push @{$dest_ref}, ECODE;
push @{$dest_ref}, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == CCODE) {
push @{$dest_ref}, CCODE;
push @{$dest_ref}, [ @{$src_ref->[$i+1]} ];
push @{$dest_ref}, $src_ref->[$i+2];
$i += 3;
}
else {
push @{$dest_ref}, $src_ref->[$i];
++$i;
}
}
}
# Parameters: par1 - reference to the array of replacements
# par2, par3, .. - strings that will go through replacement
# procedure
# par n - token that special variables start with
# Action: Strings par2, par3, .. will be searched for special variables
# (like $0, $1, $2, ..) that will be replaced with 1st, 2nd, ..
# element from array par1. If the token symbol is followed by
# another token symbol, they will be replaced by a single token
# (e.g., $$ -> $).
sub subst_string {
my($subst_ref) = shift @_;
my($token) = pop @_;
my($token2, $msg);
# variable will not be substituted if it doesn't exist or its value is undef
$token2 = quotemeta($token);
foreach $msg (@_) {
if (index($msg, $token) == -1) { next; }
$msg =~ s/$token2(\d+|$token2)/
($1 eq $token)?$token:
(defined($subst_ref->[$1])?$subst_ref->[$1]:"$token$1")/egx;
}
}
# Parameters: par1 - reference to the array of replacements
# par2, par3, .. - regular expressions that will go through
# replacement procedure
# par n - token that special variables start with
# Action: Regular expressions par2, par3, .. will be searched for special
# variables (like $1, $2, ..) that will be replaced with 1st,
# 2nd, .. element from array par1
sub subst_regexp {
my($subst_ref) = shift @_;
my($token) = pop @_;
my($subst, @subst_modified);
@subst_modified = @{$subst_ref};
foreach $subst (@subst_modified) {
if (defined($subst)) { $subst = quotemeta($subst); }
}
subst_string(\@subst_modified, @_, $token);
}
# Parameters: par1 - reference to the array of replacements
# par2 - reference to a context formula
# par3 - token that special variables start with
# Action: Context formula par2 will be searched for special variables
# (like $1, $2, ..) that will be replaced with 1st, 2nd, .. element
# from array par1
sub subst_context {
my($subst_ref) = $_[0];
my($ref) = $_[1];
my($token) = $_[2];
my($i, $j);
$i = 0;
$j = scalar(@{$ref});
while ($i < $j) {
if ($ref->[$i] == OPERAND) {
subst_string($subst_ref, $ref->[$i+1], $token);
$i += 2;
}
elsif ($ref->[$i] == EXPRESSION) {
subst_context($subst_ref, $ref->[$i+1], $token);
$i += 2;
}
elsif ($ref->[$i] == ECODE) {
subst_string($subst_ref, $ref->[$i+1], $token);
$i += 2;
}
elsif ($ref->[$i] == CCODE) {
subst_string($subst_ref, @{$ref->[$i+1]}, $token);
$i += 3;
}
else { ++$i; }
}
}
# Parameters: par1 - reference to the array of replacements
# par2 - reference to action list
# par3 - token that special variables start with
# Action: action list par2 will be searched for special variables
# (like $1, $2, ..) that will be replaced with 1st, 2nd, ..
# element from array par1
sub subst_actionlist {
my($subst_ref) = $_[0];
my($actionlist) = $_[1];
my($token) = $_[2];
my($subst, @subst_modified);
my($i, $j);
# mask %-signs in substitutions, in order to prevent incorrect
# %<alnum>-variable interpretations
@subst_modified = @{$subst_ref};
foreach $subst (@subst_modified) {
if (defined($subst)) { $subst =~ s/%/%%/g; }
}
# process the action list
$i = 0;
$j = scalar(@{$actionlist});
while ($i < $j) {
if ($actionlist->[$i] == NONE) { ++$i; }
elsif ($actionlist->[$i] == LOGONLY) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == WRITE) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == SHELLCOMMAND) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == SPAWN) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == PIPE) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == CREATECONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_actionlist($subst_ref, $actionlist->[$i+3], $token);
$i += 4;
}
elsif ($actionlist->[$i] == DELETECONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == OBSOLETECONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == SETCONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_actionlist($subst_ref, $actionlist->[$i+3], $token);
$i += 4;
}
elsif ($actionlist->[$i] == ALIAS) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == UNALIAS) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 2;
}
elsif ($actionlist->[$i] == ADD) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == FILL) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == REPORT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == COPYCONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 3;
}
elsif ($actionlist->[$i] == EMPTYCONTEXT) {
subst_string(\@subst_modified, $actionlist->[$i+1], $token);
$i += 3;
}
elsif ($actionlist->[$i] == EVENT) {
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == RESET) {
subst_string(\@subst_modified, $actionlist->[$i+3], $token);
$i += 4;
}
elsif ($actionlist->[$i] == ASSIGN) {
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == EVAL) {
subst_string(\@subst_modified, $actionlist->[$i+2], $token);
$i += 3;
}
elsif ($actionlist->[$i] == CALL) {
subst_string(\@subst_modified, @{$actionlist->[$i+3]}, $token);
$i += 4;
}
}
}
# Parameters: par1 - reference to an element from list %corr_list
# par2 - time
# Action: search event-time list that is associated with element par1,
# and remove those elements that are obsolete by time par2
sub update_times {
my($ref) = $_[0];
my($time) = $_[1];
while (scalar(@{$ref->{"Times"}})) {
if ($time - $ref->{"Times"}->[0] <= $ref->{"Window"}) { last; }
shift @{$ref->{"Times"}};
}
if (scalar(@{$ref->{"Times"}})) {
$ref->{"Time"} = $ref->{"Times"}->[0];
} else {
$ref->{"Time"} = 0;
}
}
# Parameters: par1, par2, .. - strings
# Action: calculate unique key for strings par1, par2, .. that will be
# used in correlation lists to distinguish between differents events
sub gen_key {
return join(SEPARATOR, @_);
}
# Parameters: par1 - name of the configuration file
# Action: search the rules from configuration file par1 and check, if
# there is a matching rule for the current content of input buffer.
# If matching rule is found, new element (that corresponds to
# an event correlation operation) will be added to the list
# %corr_list. Key for new element is calculated by calling gen_key
# function:
# gen_key(file name, rule number, textual description of event)
sub process_rules {
my($conffile) = $_[0];
my($key, $ref, $ref2);
my($time, $match_found, $i);
my($desc, $pattern2, $desc2);
my($pid, $script);
my($below_threshold, $inside_window);
my($subst, @subst);
my($context, $context2);
my($action, $action2);
foreach $ref (@{$configuration{$conffile}}) {
# skip CALENDAR rule
if ($ref->{"Type"} == CALENDAR) { next; }
# check if the rule context expression must be evaluated before
# comparing input line(s) with the pattern
if ($ref->{"ContPreEval"}) {
# if the value of the context expression is FALSE and the rule is
# of type Pair*, look also for all active correlation operations
# associated with the current rule and check if 2nd pattern matches
if (!valid_formula($ref->{"Context"})) {
if ( ($ref->{"Type"} == PAIR || $ref->{"Type"} == PAIR_W_WINDOW)
&& scalar(%{$ref->{"Operations"}}) ) {
if (process_rules2($ref) &&
$ref->{"WhatNext2"} == DONTCONT) { return 1; }
}
next;
}
$context = $ref->{"Context"};
}
# Check if last N lines of input buffer match the pattern
# specified by rule (value of N is also specified by rule)
# If match was found, set $match_found to 1
# If the pattern returned any values, assign them to @subst,
# otherwise leave @subst empty
if ($ref->{"PatType"} == REGEXP) {
$match_found =
match_regexp($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);
} elsif ($ref->{"PatType"} == SUBSTR) {
$match_found = match_substr($ref->{"PatLines"}, $ref->{"Pattern"});
@subst = ();
} elsif ($ref->{"PatType"} == PERLFUNC) {
$match_found =
match_perlfunc($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);
} elsif ($ref->{"PatType"} == NREGEXP) {
$match_found =
!match_regexp($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);
} elsif ($ref->{"PatType"} == NSUBSTR) {
$match_found = !match_substr($ref->{"PatLines"}, $ref->{"Pattern"});
@subst = ();
} elsif ($ref->{"PatType"} == NPERLFUNC) {
$match_found =
!match_perlfunc($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);
} elsif ($ref->{"PatType"} == TVALUE) {
$match_found = $ref->{"Pattern"};
@subst = ();
}
# If match was found, process the event
if ($match_found) {
# Evaluate the context expression of the rule
if (!scalar(@{$ref->{"Context"}})) { $context = []; }
elsif (!$ref->{"ContPreEval"}) {
if (scalar(@subst)) {
$context = [];
copy_context($ref->{"Context"}, $context);
subst_context(\@subst, $context, '$');
} else { $context = $ref->{"Context"}; }
# if the value of the context expression is FALSE and the rule is
# of type Pair*, look also for all active correlation operations
# associated with the current rule and check if 2nd pattern matches
if (!valid_formula($context)) {
if ( ($ref->{"Type"} == PAIR || $ref->{"Type"} == PAIR_W_WINDOW)
&& scalar(%{$ref->{"Operations"}}) ) {
if (process_rules2($ref) &&
$ref->{"WhatNext2"} == DONTCONT) { return 1; }
}
next;
}
}
# increment the counter that reflects the rule usage
# (just for statistical purposes)
++$ref->{"MatchCount"};
# ------------------------------------------------------------
# SINGLE rule
# ------------------------------------------------------------
if ($ref->{"Type"} == SINGLE) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) {
$action = [];
copy_actionlist($ref->{"Action"}, $action);
subst_actionlist(\@subst, $action, '$');
subst_string(\@subst, $desc, '$');
} else { $action = $ref->{"Action"}; }
execute_actionlist($action, $desc);
}
# ------------------------------------------------------------
# SINGLE_W_SCRIPT rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_SCRIPT) {
$desc = $ref->{"Desc"};
$script = $ref->{"Script"};
if (scalar(@subst)) {
$action = [];
$action2 = [];
copy_actionlist($ref->{"Action"}, $action);
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action, '$');
subst_actionlist(\@subst, $action2, '$');
subst_string(\@subst, $desc, $script, '$');
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
}
$pid = pipe_cmd($script, \%context_list);
if (defined($pid)) {
$children{$pid}->{"Desc"} = $desc;
$children{$pid}->{"Action"} = $action;
$children{$pid}->{"Action2"} = $action2;
}
}
# ------------------------------------------------------------
# SINGLE_W_SUPPRESS rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_SUPPRESS) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) { subst_string(\@subst, $desc, '$'); }
$key = gen_key($conffile, $ref->{"ID"}, $desc);
$time = time();
# if there is no event correlation operation for the key, or
# the operation with the key has expired, start the new operation
if (!exists($corr_list{$key}) ||
$time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) {
if (scalar(@subst)) {
$action = [];
copy_actionlist($ref->{"Action"}, $action);
subst_actionlist(\@subst, $action, '$');
} else { $action = $ref->{"Action"}; }
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action };
execute_actionlist($action, $desc);
}
}
# ------------------------------------------------------------
# PAIR rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == PAIR) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) { subst_string(\@subst, $desc, '$'); }
$key = gen_key($conffile, $ref->{"ID"}, $desc);
$time = time();
# if there is no event correlation operation for the key, or
# the operation with the key has expired, start the new operation
if ( !exists($corr_list{$key}) || ($ref->{"Window"} &&
$time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) ) {
$pattern2 = $ref->{"Pattern2"};
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action = [];
copy_actionlist($ref->{"Action"}, $action);
subst_actionlist(\@subst, $action, '$');
$action2 = [];
copy_actionlist($ref->{"Action2"}, $action2);
$context2 = [];
copy_context($ref->{"Context2"}, $context2);
if ($ref->{"PatType2"} == REGEXP ||
$ref->{"PatType2"} == NREGEXP) {
subst_regexp(\@subst, $pattern2, '$');
$pattern2 = qr/$pattern2/;
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
foreach $subst (@subst) {
if (defined($subst)) { $subst =~ s/\$/\$\$/g; }
}
subst_string(\@subst, $desc2, '%');
subst_actionlist(\@subst, $action2, '%');
subst_context(\@subst, $context2, '%');
} elsif ($ref->{"PatType2"} == PERLFUNC ||
$ref->{"PatType2"} == NPERLFUNC) {
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
foreach $subst (@subst) {
if (defined($subst)) { $subst =~ s/\$/\$\$/g; }
}
subst_string(\@subst, $desc2, '%');
subst_actionlist(\@subst, $action2, '%');
subst_context(\@subst, $context2, '%');
} elsif ($ref->{"PatType2"} == SUBSTR ||
$ref->{"PatType2"} == NSUBSTR) {
subst_string(\@subst, $pattern2, $desc2, '$');
subst_actionlist(\@subst, $action2, '$');
subst_context(\@subst, $context2, '$');
} else {
subst_string(\@subst, $desc2, '$');
subst_actionlist(\@subst, $action2, '$');
subst_context(\@subst, $context2, '$');
}
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
$context2 = $ref->{"Context2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Pattern2" => $pattern2,
"Context2" => $context2,
"Desc2" => $desc2,
"Action2" => $action2 };
$ref->{"Operations"}->{$key} = $corr_list{$key};
execute_actionlist($action, $desc);
}
}
# ------------------------------------------------------------
# PAIR_W_WINDOW rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == PAIR_W_WINDOW) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) { subst_string(\@subst, $desc, '$'); }
$key = gen_key($conffile, $ref->{"ID"}, $desc);
$time = time();
# if there is an event correlation operation for the key and
# the operation has expired, execute the first action list and
# terminate the operation
if (exists($corr_list{$key}) &&
$time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) {
execute_actionlist($corr_list{$key}->{"Action"}, $desc);
delete $corr_list{$key};
delete $ref->{"Operations"}->{$key};
}
# if there is no event correlation operation for the key,
# start the new operation
if (!exists($corr_list{$key})) {
$pattern2 = $ref->{"Pattern2"};
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action = [];
copy_actionlist($ref->{"Action"}, $action);
subst_actionlist(\@subst, $action, '$');
$action2 = [];
copy_actionlist($ref->{"Action2"}, $action2);
$context2 = [];
copy_context($ref->{"Context2"}, $context2);
if ($ref->{"PatType2"} == REGEXP ||
$ref->{"PatType2"} == NREGEXP) {
subst_regexp(\@subst, $pattern2, '$');
$pattern2 = qr/$pattern2/;
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
foreach $subst (@subst) {
if (defined($subst)) { $subst =~ s/\$/\$\$/g; }
}
subst_string(\@subst, $desc2, '%');
subst_actionlist(\@subst, $action2, '%');
subst_context(\@subst, $context2, '%');
} elsif ($ref->{"PatType2"} == PERLFUNC ||
$ref->{"PatType2"} == NPERLFUNC) {
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
foreach $subst (@subst) {
if (defined($subst)) { $subst =~ s/\$/\$\$/g; }
}
subst_string(\@subst, $desc2, '%');
subst_actionlist(\@subst, $action2, '%');
subst_context(\@subst, $context2, '%');
} elsif ($ref->{"PatType2"} == SUBSTR ||
$ref->{"PatType2"} == NSUBSTR) {
subst_string(\@subst, $pattern2, $desc2, '$');
subst_actionlist(\@subst, $action2, '$');
subst_context(\@subst, $context2, '$');
} else {
subst_string(\@subst, $desc2, '$');
subst_actionlist(\@subst, $action2, '$');
subst_context(\@subst, $context2, '$');
}
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
$context2 = $ref->{"Context2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Pattern2" => $pattern2,
"Context2" => $context2,
"Desc2" => $desc2,
"Action2" => $action2 };
$ref->{"Operations"}->{$key} = $corr_list{$key};
}
}
# ------------------------------------------------------------
# SINGLE_W_THRESHOLD rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) { subst_string(\@subst, $desc, '$'); }
$key = gen_key($conffile, $ref->{"ID"}, $desc);
$time = time();
# if there is no event correlation operation for the key,
# start the new operation
if (!exists($corr_list{$key})) {
if (scalar(@subst)) {
$action = [];
$action2 = [];
copy_actionlist($ref->{"Action"}, $action);
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action, '$');
subst_actionlist(\@subst, $action2, '$');
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Times" => [],
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Action2" => $action2,
"Threshold" => $ref->{"Threshold"} };
}
$ref2 = $corr_list{$key};
# inside_window - TRUE if we are still in time window
# below_threshold - TRUE if we were below threshold before this event
$inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window"});
$below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold"});
if ($inside_window && $below_threshold) {
# if we are inside time window and below threshold, increase
# the counter, and if new value of the counter equals to threshold,
# execute the action list
push @{$ref2->{"Times"}}, $time;
if (scalar(@{$ref2->{"Times"}}) == $ref->{"Threshold"}) {
execute_actionlist($ref2->{"Action"}, $desc);
}
}
elsif ($below_threshold) {
# if we are already outside time window but still below
# threshold, slide the window forward
push @{$ref2->{"Times"}}, $time;
update_times($ref2, $time);
}
elsif (!$inside_window) {
# if we are both outside time window and above threshold, then
# the 1st action list was executed in the past and this event
# correlation operation has been suppressing post-action events;
# since the operation has expired, execute its 2nd action list
# and start the new operation, because the event we have received
# matches the rule.
execute_actionlist($ref2->{"Action2"}, $desc);
if (scalar(@subst)) {
$action = [];
$action2 = [];
copy_actionlist($ref->{"Action"}, $action);
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action, '$');
subst_actionlist(\@subst, $action2, '$');
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Times" => [ $time ],
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Action2" => $action2,
"Threshold" => $ref->{"Threshold"} };
if ($ref->{"Threshold"} == 1) {
execute_actionlist($action, $desc);
}
}
}
# ------------------------------------------------------------
# SINGLE_W_2_THRESHOLDS rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {
$desc = $ref->{"Desc"};
if (scalar(@subst)) { subst_string(\@subst, $desc, '$'); }
$key = gen_key($conffile, $ref->{"ID"}, $desc);
$time = time();
# if there is no event correlation operation for the key,
# start the new operation
if (!exists($corr_list{$key})) {
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action = [];
$action2 = [];
copy_actionlist($ref->{"Action"}, $action);
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action, '$');
subst_actionlist(\@subst, $action2, '$');
subst_string(\@subst, $desc2, '$');
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Times" => [],
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Threshold" => $ref->{"Threshold"},
"2ndPass" => 0,
"Window2" => $ref->{"Window2"},
"Threshold2" => $ref->{"Threshold2"},
"Desc2" => $desc2,
"Action2" => $action2 };
}
$ref2 = $corr_list{$key};
# the 1st round of counting with a rising threshold
if (!$ref2->{"2ndPass"}) {
# inside_window - TRUE if we are still in time window
# below_threshold - TRUE if we were below threshold before this event
$inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window"});
$below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold"});
if ($inside_window) {
# if we are inside time window, increase the counter, and
# if new value of the counter equals to threshold, execute
# the action list and start to check 2nd threshold
push @{$ref2->{"Times"}}, $time;
if (scalar(@{$ref2->{"Times"}}) == $ref->{"Threshold"}) {
$ref2->{"Time"} = $time;
$ref2->{"2ndPass"} = 1;
$ref2->{"Times"} = [];
execute_actionlist($ref2->{"Action"}, $desc);
}
}
elsif ($below_threshold) {
# if we are already outside time window but still below
# threshold, slide the window forward
push @{$ref2->{"Times"}}, $time;
update_times($ref2, $time);
}
# the 2nd round of counting with a falling threshold
} else {
# inside_window - TRUE if we are still in time window
# below_threshold - TRUE if we were below threshold before this event
$inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window2"});
$below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold2"});
if ($inside_window && $below_threshold) {
# if we are both inside time window and below threshold,
# we can increase the counter (this threshold is considered
# as crossed if counter > threshold, counter == threshold
# is still permitted).
push @{$ref2->{"Times"}}, $time;
}
elsif ($inside_window) {
# if we are inside the time window and below_threshold == FALSE
# then together with current event we have crossed the threshold
# (counter > threshold). So we have to slide the window.
if ($ref->{"Threshold2"}) {
shift @{$ref2->{"Times"}};
push @{$ref2->{"Times"}}, $time;
$ref2->{"Time"} = $ref2->{"Times"}->[0];
} else { $ref2->{"Time"} = $time; }
}
else {
# if we have reached here, we must be outside time window
# and also below threshold, since threshold crossing would
# have already been detected by previous code block.
# So we can execute the action list.
execute_actionlist($ref2->{"Action2"}, $ref2->{"Desc2"});
# since action was just executed we can terminate this event
# correlation operation and start the new one, because the event
# we have received matches the rule.
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action = [];
$action2 = [];
copy_actionlist($ref->{"Action"}, $action);
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action, '$');
subst_actionlist(\@subst, $action2, '$');
subst_string(\@subst, $desc2, '$');
} else {
$action = $ref->{"Action"};
$action2 = $ref->{"Action2"};
}
$corr_list{$key} = { "Time" => $time,
"Type" => $ref->{"Type"},
"File" => $conffile,
"ID" => $ref->{"ID"},
"Times" => [ $time ],
"Window" => $ref->{"Window"},
"Context" => $context,
"Desc" => $desc,
"Action" => $action,
"Threshold" => $ref->{"Threshold"},
"2ndPass" => 0,
"Window2" => $ref->{"Window2"},
"Threshold2" => $ref->{"Threshold2"},
"Desc2" => $desc2,
"Action2" => $action2 };
if ($ref->{"Threshold"} == 1) {
$corr_list{$key}->{"2ndPass"} = 1;
$corr_list{$key}->{"Times"} = [];
execute_actionlist($action, $desc);
}
}
}
}
# ------------------------------------------------------------
# SUPPRESS rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SUPPRESS) { return 1; }
# ------------------------------------------------------------
# if match was found and rule's continue-parameter
# is set to DontCont, return 1, otherwise return 0
if ($ref->{"WhatNext"} == DONTCONT) { return 1; }
} else {
# if match was not found and rule is of type Pair*, look also for
# all active correlation operations associated with the current
# rule and check if 2nd pattern matches
if ( ($ref->{"Type"} == PAIR || $ref->{"Type"} == PAIR_W_WINDOW)
&& scalar(%{$ref->{"Operations"}}) ) {
if (process_rules2($ref) &&
$ref->{"WhatNext2"} == DONTCONT) { return 1; }
}
}
}
return 0;
}
# Parameters: par1 - reference to a rule
# Action: search the event correlation operations associated with Pair*
# rules and check, if there is a matching event for the current
# content of input buffer. If there were 1 or more matches found,
# return 1, otherwise return 0
sub process_rules2 {
my($elem) = $_[0];
my($key, $ref, $ret);
my($match_found, @subst);
my($type, $window);
my($pattype2, $patlines2, $desc2);
my($context2, $action2);
$ret = 0; # shows if matches were found
$type = $elem->{"Type"};
$pattype2 = $elem->{"PatType2"};
$patlines2 = $elem->{"PatLines2"};
$window = $elem->{"Window"};
foreach $key (keys %{$elem->{"Operations"}}) {
if (!exists($elem->{"Operations"}->{$key})) { next; }
$ref = $elem->{"Operations"}->{$key};
# check if the rule context expression must be evaluated before
# comparing input line(s) with the pattern
if ($elem->{"ContPreEval2"}) {
if (!valid_formula($ref->{"Context2"})) { next; }
}
# Check if last N lines of input buffer match the pattern
# If match was found, set $match_found to 1
# If the pattern returned any values, assign them to @subst,
# otherwise leave @subst empty
if ($pattype2 == REGEXP) {
$match_found =
match_regexp($patlines2, $ref->{"Pattern2"}, \@subst);
} elsif ($pattype2 == SUBSTR) {
$match_found = match_substr($patlines2, $ref->{"Pattern2"});
@subst = ();
} elsif ($pattype2 == PERLFUNC) {
$match_found =
match_perlfunc($patlines2, $ref->{"Pattern2"}, \@subst);
} elsif ($pattype2 == NREGEXP) {
$match_found =
!match_regexp($patlines2, $ref->{"Pattern2"}, \@subst);
} elsif ($pattype2 == NSUBSTR) {
$match_found = !match_substr($patlines2, $ref->{"Pattern2"});
@subst = ();
} elsif ($pattype2 == NPERLFUNC) {
$match_found =
!match_perlfunc($patlines2, $ref->{"Pattern2"}, \@subst);
} elsif ($pattype2 == TVALUE) {
$match_found = $ref->{"Pattern2"};
@subst = ();
}
# If match was found, process the event
if ($match_found) {
# Evaluate the context expression of the rule
if (scalar(@{$ref->{"Context2"}}) && !$elem->{"ContPreEval2"}) {
if (scalar(@subst)) {
$context2 = [];
copy_context($ref->{"Context2"}, $context2);
subst_context(\@subst, $context2, '$');
} else { $context2 = $ref->{"Context2"}; }
if (!valid_formula($context2)) { next; }
}
# processing for PAIR rule
if ($type == PAIR) {
# if we are inside time window, execute 2nd action list
if (!$window || time() - $ref->{"Time"} <= $window) {
$ret = 1;
++$elem->{"MatchCount"};
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action2 = [];
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action2, '$');
subst_string(\@subst, $desc2, '$');
} else { $action2 = $ref->{"Action2"}; }
execute_actionlist($action2, $desc2);
}
# now we can terminate this event correlation operation,
# since we have seen the event that matches the second pattern
delete $corr_list{$key};
delete $elem->{"Operations"}->{$key};
}
# processing for PAIR_W_WINDOW rule
elsif ($type == PAIR_W_WINDOW) {
# we can terminate this event correlation operation,
# since we have seen the event that matches the second pattern
# (in order to achieve good event ordering, execute 2nd action
# list without checking the window)
$ret = 1;
++$elem->{"MatchCount"};
$desc2 = $ref->{"Desc2"};
if (scalar(@subst)) {
$action2 = [];
copy_actionlist($ref->{"Action2"}, $action2);
subst_actionlist(\@subst, $action2, '$');
subst_string(\@subst, $desc2, '$');
} else { $action2 = $ref->{"Action2"}; }
execute_actionlist($action2, $desc2);
delete $corr_list{$key};
delete $elem->{"Operations"}->{$key};
}
}
}
# if there were 1 or more matches found, return 1, otherwise return 0
return $ret;
}
# Parameters: -
# Action: search lists %corr_list, %context_list, @calendar and
# @pending_events, performing timed tasks that are associated
# with elements and removing obsolete elements
sub process_lists {
my($key, $ref, $config);
my($time, $diff, $lastdayofmonth);
my(@time, $event, @buffer);
my($minute, $hour, $day, $month, $weekday);
# remove obsolete elements from %context_list
foreach $key (keys %context_list) { valid_context($key); }
# move pending events that have become relevant from
# @pending_events list to @events list
if (scalar(@pending_events)) {
@buffer = ();
foreach $ref (@pending_events) {
if (time() >= $ref->[0]) {
$event = $ref->[1];
log_msg(LOG_DEBUG, "Creating event '$event'");
push @events, $event;
} else { push @buffer, $ref; }
}
@pending_events = @buffer;
}
# process CALENDAR rules
@time = localtime(time());
$minute = $time[1];
$hour = $time[2];
$day = $time[3];
$month = $time[4];
$weekday = $time[6];
$lastdayofmonth = ((localtime(time()+86400))[3] == 1);
foreach $ref (@calendar) {
# if we have already performed this task in current minute, skip
if ($minute == $ref->{"LastMinute"} &&
$hour == $ref->{"LastHour"} &&
$day == $ref->{"LastDay"} &&
$month == $ref->{"LastMonth"} &&
$weekday == $ref->{"LastWeekday"}) { next; }
# if one of the time conditions does not hold, skip
if (!exists($ref->{"Minutes"}->{$minute})) { next; }
if (!exists($ref->{"Hours"}->{$hour})) { next; }
if (!exists($ref->{"Days"}->{$day}) &&
!($lastdayofmonth && exists($ref->{"Days"}->{"0"}))) { next; }
if (!exists($ref->{"Months"}->{$month})) { next; }
if (!exists($ref->{"Weekdays"}->{$weekday})) { next; }
# check the context expression of the rule
if (scalar(@{$ref->{"Context"}})) {
if (!valid_formula($ref->{"Context"})) { next; }
}
# execute the action list of the calendar event
# and save current time
execute_actionlist($ref->{"Action"}, $ref->{"Desc"});
$ref->{"LastMinute"} = $minute;
$ref->{"LastHour"} = $hour;
$ref->{"LastDay"} = $day;
$ref->{"LastMonth"} = $month;
$ref->{"LastWeekday"} = $weekday;
++$ref->{"MatchCount"};
}
# perform timed tasks that are associated with elements of
# %corr_list and remove obsolete elements
foreach $key (keys %corr_list) {
if (!exists($corr_list{$key})) { next; }
$ref = $corr_list{$key};
$time = time();
$diff = $time - $ref->{"Time"};
$config = $configuration{$ref->{"File"}}->[$ref->{"ID"}];
# ------------------------------------------------------------
# SINGLE_W_SUPPRESS rule
# ------------------------------------------------------------
if ($ref->{"Type"} == SINGLE_W_SUPPRESS) {
# if we are outside time window, list element is obsolete
# and can be removed
if ($diff > $ref->{"Window"}) { delete $corr_list{$key}; }
}
# ------------------------------------------------------------
# PAIR rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == PAIR) {
# if we are outside time window, list elements are obsolete
# and can be removed
if ($ref->{"Window"} && $diff > $ref->{"Window"}) {
delete $corr_list{$key};
delete $config->{"Operations"}->{$key};
}
}
# ------------------------------------------------------------
# PAIR_W_WINDOW rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == PAIR_W_WINDOW) {
# if we are outside time window, 1st action must be executed;
# after that the list elements are obsolete and can be removed
if ($diff > $ref->{"Window"}) {
execute_actionlist($ref->{"Action"}, $ref->{"Desc"});
delete $corr_list{$key};
delete $config->{"Operations"}->{$key};
}
}
# ------------------------------------------------------------
# SINGLE_W_THRESHOLD rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {
if ($diff > $ref->{"Window"}) {
if (scalar(@{$ref->{"Times"}}) < $ref->{"Threshold"}) {
# If we are outside time window and threshold is not exceeded,
# try to slide the window. If all events are gone after sliding,
# remove the list element as obsolete.
update_times($ref, $time);
if (!scalar(@{$ref->{"Times"}})) { delete $corr_list{$key}; }
} else {
# If we are outside time window and threshold is exceeded,
# execute the 2nd action and remove the list element as obsolete.
execute_actionlist($ref->{"Action2"}, $ref->{"Desc"});
delete $corr_list{$key};
}
}
}
# ------------------------------------------------------------
# SINGLE_W_2_THRESHOLDS rule
# ------------------------------------------------------------
elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {
if (!$ref->{"2ndPass"}) {
# If we are outside 1st time window, try to slide the window.
# If all events are gone after sliding, remove the list element
# as obsolete
if ($diff > $ref->{"Window"}) {
update_times($ref, $time);
if (!scalar(@{$ref->{"Times"}})) { delete $corr_list{$key}; }
}
} else {
# If we are outside 2nd time window and list element
# has not been removed, we can conclude that 2nd threshold was
# not exceeded, and so 2nd action can be executed.
# After that the list element can be removed as obsolete.
if ($diff > $ref->{"Window2"}) {
execute_actionlist($ref->{"Action2"}, $ref->{"Desc2"});
delete $corr_list{$key};
}
}
}
}
}
#################################################
# Functions related to reporting and data dumping
#################################################
# Parameters: par1 - reference to a action list
# Action: convert action list to a string representation
sub actionlist2str {
my($actionlist) = $_[0];
my($i, $j);
my($result);
$i = 0;
$j = scalar(@{$actionlist});
$result = "";
while ($i < $j) {
if ($actionlist->[$i] == NONE) {
$result .= "none";
++$i;
}
elsif ($actionlist->[$i] == LOGONLY) {
$result .= "logonly " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == WRITE) {
$result .= "write " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == SHELLCOMMAND) {
$result .= "shellcmd " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == SPAWN) {
$result .= "spawn " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == PIPE) {
$result .= "pipe " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CREATECONTEXT) {
$result .= "create " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
if (scalar(@{$actionlist->[$i+3]})) {
$result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";
}
$i += 4;
}
elsif ($actionlist->[$i] == DELETECONTEXT) {
$result .= "delete " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == OBSOLETECONTEXT) {
$result .= "obsolete " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == SETCONTEXT) {
$result .= "set " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
if (scalar(@{$actionlist->[$i+3]})) {
$result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";
}
$i += 4;
}
elsif ($actionlist->[$i] == ALIAS) {
$result .= "alias " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == UNALIAS) {
$result .= "unalias " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == ADD) {
$result .= "add " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == FILL) {
$result .= "fill " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == REPORT) {
$result .= "report " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == COPYCONTEXT) {
$result .= "copy " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == EMPTYCONTEXT) {
if (length($actionlist->[$i+2])) {
$result .= "empty " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
} else {
$result .= "empty " . $actionlist->[$i+1];
}
$i += 3;
}
elsif ($actionlist->[$i] == EVENT) {
$result .= "event " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == RESET) {
$result .= "reset " . $actionlist->[$i+2] . " " . $actionlist->[$i+3];
$i += 4;
}
elsif ($actionlist->[$i] == ASSIGN) {
$result .= "assign %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == EVAL) {
$result .= "eval %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CALL) {
$result .= "call %" . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]
. " " . join(" ", @{$actionlist->[$i+3]});
$i += 4;
}
else { $result .= "unknown action type"; }
$result .= "; ";
}
return $result;
}
# Parameters: par1 - pattern type
# par2 - pattern lines
# par3 - pattern
# Action: convert pattern to a printable representation
sub pattern2str {
my($type) = $_[0];
my($lines) = $_[1];
my($pattern) = $_[2];
if ($type == SUBSTR) {
return "substring for $lines line(s): $pattern";
}
elsif ($type == REGEXP) {
return "regexp for $lines line(s): $pattern";
}
elsif ($type == PERLFUNC) {
return "perlfunc for $lines line(s): $pattern";
}
elsif ($type == NSUBSTR) {
return "negative substring for $lines line(s): $pattern";
}
elsif ($type == NREGEXP) {
return "negative regexp for $lines line(s): $pattern";
}
elsif ($type == NPERLFUNC) {
return "negative perlfunc for $lines line(s): $pattern";
}
elsif ($type == TVALUE) {
return "truth value: " . ($pattern?"TRUE":"FALSE");
}
else { return "Unknown pattern type"; }
}
# Parameters: par1 - reference to a context formula
# Action: convert given context to a printable representation
sub context2str {
my($ref) = $_[0];
my($i, $j, $op1, $op2);
my(@stack, $result);
$i = 0;
$j = scalar(@{$ref});
@stack = ();
while ($i < $j) {
if ($ref->[$i] == EXPRESSION) {
$op1 = $ref->[$i+1];
push @stack, "(" . context2str($op1) . ")";
$i += 2;
}
elsif ($ref->[$i] == ECODE) {
$op1 = $ref->[$i+1];
push @stack, "=( " . $op1 . " )";
$i += 2;
}
elsif ($ref->[$i] == CCODE) {
$op1 = $ref->[$i+1];
$op2 = $ref->[$i+2];
push @stack, join(" ", @{$op1}) . " -> " . $op2;
$i += 3;
}
elsif ($ref->[$i] == OPERAND) {
$op1 = $ref->[$i+1];
push @stack, $op1;
$i += 2;
}
elsif ($ref->[$i] == NEGATION) {
$op1 = pop @stack;
push @stack, "!" . $op1;
++$i;
}
elsif ($ref->[$i] == AND) {
$op2 = pop @stack;
$op1 = pop @stack;
push @stack, $op1 . " && " . $op2;
++$i;
}
elsif ($ref->[$i] == OR) {
$op2 = pop @stack;
$op1 = pop @stack;
push @stack, $op1 . " || " . $op2;
++$i;
}
}
$result = pop @stack;
if (!defined($result)) { $result = ""; }
return $result;
}
# Parameters: par1 - filehandle
# par2 - list element key
# par3 - reference to list element
# Action: print given list element to the filehandle
sub print_element {
my($handle) = $_[0];
my($key) = $_[1];
my($ref) = $_[2];
my($config, $conffile, $id, $time);
print $handle "Key:\t\t\t\t", $key, "\n";
print $handle "Start of correlation operation:\t",
scalar(localtime($ref->{"Time"})), "\n";
$conffile = $ref->{"File"};
$id = $ref->{"ID"};
$config = $configuration{$conffile}->[$id];
print $handle "Configuration file:\t\t", $conffile, "\n";
print $handle "Rule number:\t\t\t", $id+1, "\n";
print $handle "Rule internal ID:\t\t", $id, "\n";
if ($ref->{"Type"} == SINGLE_W_SUPPRESS) {
print $handle "Type:\t\t\t\t";
print $handle "SingleWithSuppress\n";
if ($config->{"WhatNext"} == DONTCONT) {
print $handle "Behaviour after match:\t\t", "don't continue\n";
} else {
print $handle "Behaviour after match:\t\t", "take next\n";
}
print $handle "Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType"},
$config->{"PatLines"}, $config->{"Pattern"});
print $handle "\n";
print $handle "Context:\t\t\t";
print $handle context2str($ref->{"Context"});
print $handle "\n";
print $handle "Event:\t\t\t\t", $ref->{"Desc"}, "\n";
print $handle "Action:\t\t\t\t";
print $handle actionlist2str($ref->{"Action"});
print $handle "\n";
print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";
print $handle "\n";
}
elsif ($ref->{"Type"} == PAIR) {
print $handle "Type:\t\t\t\t";
print $handle "Pair\n";
if ($config->{"WhatNext"} == DONTCONT) {
print $handle "Behaviour after 1st match:\t", "don't continue\n";
} else {
print $handle "Behaviour after 1st match:\t", "take next\n";
}
print $handle "1st Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType"},
$config->{"PatLines"}, $config->{"Pattern"});
print $handle "\n";
print $handle "1st Context:\t\t\t";
print $handle context2str($ref->{"Context"});
print $handle "\n";
print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";
print $handle "1st Action:\t\t\t";
print $handle actionlist2str($ref->{"Action"});
print $handle "\n";
if ($config->{"WhatNext2"} == DONTCONT) {
print $handle "Behaviour after 2nd match:\t", "don't continue\n";
} else {
print $handle "Behaviour after 2nd match:\t", "take next\n";
}
print $handle "2nd Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType2"},
$config->{"PatLines2"}, $ref->{"Pattern2"});
print $handle "\n";
print $handle "2nd Context:\t\t\t";
print $handle context2str($ref->{"Context2"});
print $handle "\n";
print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";
print $handle "2nd Action:\t\t\t";
print $handle actionlist2str($ref->{"Action2"});
print $handle "\n";
if ($ref->{"Window"}) {
print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";
} else {
print $handle "Window:\t\t\t\t", "infinite\n";
}
print $handle "\n";
}
elsif ($ref->{"Type"} == PAIR_W_WINDOW) {
print $handle "Type:\t\t\t\t";
print $handle "PairWithWindow\n";
if ($config->{"WhatNext"} == DONTCONT) {
print $handle "Behaviour after 1st match:\t", "don't continue\n";
} else {
print $handle "Behaviour after 1st match:\t", "take next\n";
}
print $handle "1st Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType"},
$config->{"PatLines"}, $config->{"Pattern"});
print $handle "\n";
print $handle "Context:\t\t\t";
print $handle context2str($ref->{"Context"});
print $handle "\n";
print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";
print $handle "1st Action:\t\t\t";
print $handle actionlist2str($ref->{"Action"});
print $handle "\n";
if ($config->{"WhatNext2"} == DONTCONT) {
print $handle "Behaviour after 2nd match:\t", "don't continue\n";
} else {
print $handle "Behaviour after 2nd match:\t", "take next\n";
}
print $handle "2nd Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType2"},
$config->{"PatLines2"}, $ref->{"Pattern2"});
print $handle "\n";
print $handle "2nd Context:\t\t\t";
print $handle context2str($ref->{"Context2"});
print $handle "\n";
print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";
print $handle "2nd Action:\t\t\t";
print $handle actionlist2str($ref->{"Action2"});
print $handle "\n";
print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";
print $handle "\n";
}
elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {
print $handle "Type:\t\t\t\t";
print $handle "SingleWithThreshold\n";
if ($config->{"WhatNext"} == DONTCONT) {
print $handle "Behaviour after match:\t\t", "don't continue\n";
} else {
print $handle "Behaviour after match:\t\t", "take next\n";
}
print $handle "Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType"},
$config->{"PatLines"}, $config->{"Pattern"});
print $handle "\n";
print $handle "Context:\t\t\t";
print $handle context2str($ref->{"Context"});
print $handle "\n";
print $handle "Event:\t\t\t\t", $ref->{"Desc"}, "\n";
print $handle "1st Action:\t\t\t";
print $handle actionlist2str($ref->{"Action"});
print $handle "\n";
print $handle "2nd Action:\t\t\t";
print $handle actionlist2str($ref->{"Action2"});
print $handle "\n";
print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";
print $handle "Threshold:\t\t\t", $ref->{"Threshold"}, "\n";
print $handle scalar(@{$ref->{"Times"}}), " events observed at:\n";
foreach $time (@{$ref->{"Times"}})
{ print $handle scalar(localtime($time)), "\n"; }
print $handle "\n";
}
elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {
print $handle "Type:\t\t\t\t";
print $handle "SingleWith2Thresholds\n";
if ($config->{"WhatNext"} == DONTCONT) {
print $handle "Behaviour after match:\t\t", "don't continue\n";
} else {
print $handle "Behaviour after match:\t\t", "take next\n";
}
print $handle "Pattern:\t\t\t";
print $handle pattern2str($config->{"PatType"},
$config->{"PatLines"}, $config->{"Pattern"});
print $handle "\n";
print $handle "Context:\t\t\t";
print $handle context2str($ref->{"Context"});
print $handle "\n";
print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";
print $handle "1st Action:\t\t\t";
print $handle actionlist2str($ref->{"Action"});
print $handle "\n";
print $handle "1st Window:\t\t\t", $ref->{"Window"}, " seconds\n";
print $handle "1st Threshold:\t\t\t", $ref->{"Threshold"}, "\n";
print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";
print $handle "2nd Action:\t\t\t";
print $handle actionlist2str($ref->{"Action2"});
print $handle "\n";
print $handle "2nd Window:\t\t\t", $ref->{"Window2"}, " seconds\n";
print $handle "2nd Threshold:\t\t\t", $ref->{"Threshold2"}, "\n";
print $handle scalar(@{$ref->{"Times"}}), " events observed at ";
if ($ref->{"2ndPass"}) {
print $handle "(checking 2nd threshold):\n";
} else {
print $handle "(checking 1st threshold):\n";
}
foreach $time (@{$ref->{"Times"}})
{ print $handle scalar(localtime($time)), "\n"; }
print $handle "\n";
}
}
# Parameters: -
# Action: save some information about the current state of the program
# to dump file.
sub dump_data {
my($i, $line, $key, $ref, $file, $event);
my($time, $user, $system, $cuser, $csystem);
my($name, %reported_names);
# verify that dumpfile does not exist and open it
if (-e $dumpfile) {
log_msg(LOG_ERR, "Can't write to dumpfile: $dumpfile exists");
return;
}
if (!open(DUMPFILE, ">$dumpfile")) {
log_msg(LOG_ERR, "Can't open dumpfile $dumpfile ($!)");
return;
}
$time = time();
# print program info
print DUMPFILE "Program information:\n";
print DUMPFILE '=' x 60, "\n";
print DUMPFILE "Program version: ", $SEC_VERSION, "\n";
print DUMPFILE "Time of the start: ",
scalar(localtime($startuptime)), "\n";
print DUMPFILE "Time of the last configuration load: ",
scalar(localtime($lastconfigload)), "\n";
print DUMPFILE "Time of the dump: ", scalar(localtime($time)), "\n";
print DUMPFILE "Program resource file: ", $rcfile_status, "\n";
print DUMPFILE "Program options: ", $sec_options, "\n";
print DUMPFILE "\n";
# print environment info
print DUMPFILE "Environment:\n";
print DUMPFILE '=' x 60, "\n";
foreach $key (sort(keys %ENV)) {
print DUMPFILE "$key=", $ENV{$key}, "\n";
}
print DUMPFILE "\n";
# print performance statistics
print DUMPFILE "Performance statistics:\n";
print DUMPFILE '=' x 60, "\n";
($user, $system, $cuser, $csystem) = times();
print DUMPFILE "Run time: ", $time - $startuptime, " seconds\n";
print DUMPFILE "User time: $user seconds\n";
print DUMPFILE "System time: $system seconds\n";
print DUMPFILE "Child user time: $cuser seconds\n";
print DUMPFILE "Child system time: $csystem seconds\n";
print DUMPFILE "Processed input lines: $processedlines\n";
print DUMPFILE "\n";
# print rule usage statistics
print DUMPFILE "Rule usage statistics:\n";
print DUMPFILE '=' x 60, "\n";
foreach $file (@conffiles) {
$i = 1;
print DUMPFILE "\nStatistics for the rules from $file\n";
print DUMPFILE "(loaded at ",
scalar(localtime($config_ltimes{$file})), ")\n";
print DUMPFILE '-' x 60, "\n";
foreach $ref (@{$configuration{$file}}) {
print DUMPFILE "Rule $i at line ", $ref->{"LineNo"},
" (", $ref->{"Desc"}, ") has matched ",
$ref->{"MatchCount"}, " events\n";
++$i;
}
}
print DUMPFILE "\n";
# print input sources
print DUMPFILE "Input sources:\n";
print DUMPFILE '=' x 60, "\n";
foreach $file (@inputfiles) {
print DUMPFILE $file, " ";
if ($inputsrc{$file}->{"open"}) {
print DUMPFILE "(status: Open, ";
} else {
print DUMPFILE "(status: Closed, ";
}
print DUMPFILE "received data: ",
$inputsrc{$file}->{"lines"}, " lines, ";
if ($intcontexts) {
print DUMPFILE "context: ", $inputsrc{$file}->{"context"};
} else {
print DUMPFILE "no context set";
}
print DUMPFILE ")\n";
}
print DUMPFILE "\n";
# print content of input buffer
print DUMPFILE "Content of input buffer (last $bufsize input lines):\n";
print DUMPFILE '-' x 60, "\n";
for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
print DUMPFILE $input_buffer[$i], "\n";
}
print DUMPFILE '-' x 60, "\n";
print DUMPFILE "\n";
# print last $bufsize input sources
print DUMPFILE "Last $bufsize input sources:\n";
print DUMPFILE '-' x 60, "\n";
for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
if (defined($input_sources[$i])) {
print DUMPFILE $input_sources[$i], "\n";
} else {
print DUMPFILE "SEC 'event' action\n";
}
}
print DUMPFILE '-' x 60, "\n";
print DUMPFILE "\n";
# print content of pending event buffer
$i = 0;
print DUMPFILE "Pending events:\n";
print DUMPFILE '=' x 60, "\n";
foreach $ref (@pending_events) {
print DUMPFILE "Event: ", $ref->[1], "\n";
print DUMPFILE "Will be created at: ",
scalar(localtime($ref->[0])), "\n";
print DUMPFILE "\n";
++$i;
}
print DUMPFILE "Total: $i elements\n\n";
# print the list of active event correlation operations
$i = 0;
print DUMPFILE "List of event correlation operations:\n";
print DUMPFILE '=' x 60, "\n";
while (($key, $ref) = each(%corr_list)) {
print_element(*DUMPFILE, $key, $ref);
print DUMPFILE '-' x 60, "\n";
++$i;
}
print DUMPFILE "Total: $i elements\n\n";
# print the list of active contexts
$i = 0;
%reported_names = ();
print DUMPFILE "List of contexts:\n";
print DUMPFILE '=' x 60, "\n";
while (($key, $ref) = each(%context_list)) {
if (exists($reported_names{$key})) { next; }
foreach $name (@{$ref->{"Aliases"}}) {
print DUMPFILE "Context Name: ", $name, "\n";
$reported_names{$name} = 1;
}
print DUMPFILE "Creation Time: ",
scalar(localtime($ref->{"Time"})), "\n";
if ($ref->{"Window"}) {
print DUMPFILE "Lifetime: ", $ref->{"Window"}, " seconds\n";
} else {
print DUMPFILE "Lifetime: infinite\n";
}
if (scalar(@{$ref->{"Action"}})) {
print DUMPFILE "Action on delete: ",
actionlist2str($ref->{"Action"});
print DUMPFILE " (%s = ", $ref->{"Desc"}, ")\n";
}
if (scalar(@{$ref->{"Buffer"}})) {
print DUMPFILE scalar(@{$ref->{"Buffer"}}),
" events associated with context:\n";
foreach $event (@{$ref->{"Buffer"}})
{ print DUMPFILE $event, "\n"; }
}
print DUMPFILE '-' x 60, "\n";
++$i;
}
print DUMPFILE "Total: $i elements\n\n";
# print the list of running children
$i = 0;
print DUMPFILE "Child processes:\n";
print DUMPFILE '=' x 60, "\n";
while (($key, $ref) = each(%children)) {
print DUMPFILE "Child PID: ", $key, "\n";
print DUMPFILE "Commandline started by child: ", $ref->{"cmd"}, "\n";
print DUMPFILE '-' x 60, "\n";
++$i;
}
print DUMPFILE "Total: $i elements\n\n";
# print the values of user-defined variables
$i = 0;
print DUMPFILE "User-defined variables:\n";
print DUMPFILE '=' x 60, "\n";
foreach $key (sort(keys %variables)) {
if (defined($variables{$key})) {
print DUMPFILE "%$key = '", $variables{$key}, "'\n";
} else {
print DUMPFILE "%$key = undef\n";
}
++$i;
}
print DUMPFILE "Total: $i elements\n\n";
close(DUMPFILE);
}
#################################################################
# Functions related to input handling and input buffer management
#################################################################
# Parameters: -
# Action: if the current size of the input buffer is different from
# $bufsize, change the size of the input buffer to $bufsize
# and set the global variable $bufpos accordingly
sub resize_input_buffer {
my($cursize) = scalar(@input_buffer);
my(@buf, $i, $diff);
if ($cursize > $bufsize) {
@input_buffer = @input_buffer[$bufpos - $bufsize + 1 .. $bufpos];
@input_sources = @input_sources[$bufpos - $bufsize + 1 .. $bufpos];
$bufpos = $bufsize - 1;
} elsif ($cursize < $bufsize) {
$diff = $bufsize - $cursize;
for ($i = 0; $i < $diff; ++$i) { $buf[$i] = ""; }
@input_buffer = (@buf, @input_buffer[$bufpos - $cursize + 1 .. $bufpos]);
@input_sources = (@buf, @input_sources[$bufpos - $cursize + 1 .. $bufpos]);
$bufpos = $bufsize - 1;
}
}
# Parameters: par1 - text of the SEC internal event
# Action: insert the SEC internal event par1 into the event buffer
# and match it against the rulebase.
sub internal_event {
my($text) = $_[0];
my($context, $conffile);
$context = "SEC_INTERNAL_EVENT";
log_msg(LOG_INFO, "Creating SEC internal context '$context'");
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "SEC internal",
"Aliases" => [ $context ] };
log_msg(LOG_INFO, "Creating SEC internal event '$text'");
$bufpos = ($bufpos + 1) % $bufsize;
$input_buffer[$bufpos] = $text;
$input_sources[$bufpos] = undef;
foreach $conffile (@conffiles) { process_rules($conffile); }
++$processedlines;
log_msg(LOG_INFO, "Deleting SEC internal context '$context'");
delete $context_list{$context};
}
# Parameters: par1 - process ID
# Action: read available data from process par1 and create events.
sub consume_pipe {
my($pid) = $_[0];
my($rin, $ret, $pos, $nbytes, $event);
for (;;) {
# poll the pipe with select()
$rin = '';
vec($rin, fileno($children{$pid}->{"fh"}), 1) = 1;
$ret = select($rin, undef, undef, 0);
# if select() failed because of the caught signal, try again,
# otherwise close the pipe and quit the read-loop;
# if select() returned 0, no data is available, so quit the read-loop
if (!defined($ret) || $ret < 0) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR,
"Process $pid pipe select error ($!), closing the pipe");
close($children{$pid}->{"fh"});
$children{$pid}->{"open"} = 0;
last;
} elsif ($ret == 0) { last; }
# try to read from the pipe
$nbytes = sysread($children{$pid}->{"fh"},
$children{$pid}->{"buffer"},
$blocksize, length($children{$pid}->{"buffer"}));
# if sysread() failed and the reason was other than a caught signal,
# close the pipe and quit the read-loop;
# if sysread() failed because of a caught signal, continue (posix
# allows read(2) to be interrupted by a signal and return -1, with
# some bytes already been read into read buffer);
# if sysread() returned 0, the other end has closed the pipe, so close
# our end of the pipe and quit the read-loop
if (!defined($nbytes)) {
if ($! != EINTR) {
log_msg(LOG_ERR, "Process $pid pipe IO error ($!), closing the pipe");
close($children{$pid}->{"fh"});
$children{$pid}->{"open"} = 0;
last;
}
} elsif ($nbytes == 0) {
close($children{$pid}->{"fh"});
$children{$pid}->{"open"} = 0;
last;
}
# create all lines of pipe buffer as events, except the last one
# which could be a partial line with its 2nd part still not written
for (;;) {
$pos = index($children{$pid}->{"buffer"}, "\n");
if ($pos == -1) { last; }
$event = substr($children{$pid}->{"buffer"}, 0, $pos);
substr($children{$pid}->{"buffer"}, 0, $pos + 1) = "";
log_msg(LOG_DEBUG,
"Creating event '$event' (received from child $pid)");
push @events, $event;
}
}
# if the child pipe has been closed but the pipe buffer still contains
# data (bytes with no terminating newline), create an event from this data
if (!$children{$pid}->{"open"} && length($children{$pid}->{"buffer"})) {
$event = $children{$pid}->{"buffer"};
log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)");
push @events, $event;
}
}
# Parameters: -
# Action: check the status of SEC child processes and process their output
sub check_children {
my($pid, $exitcode);
# if the child was started by 'spawn' action, gather the child
# standard output and create events (if child has more than PIPE_BUF
# bytes to write, we must start reading from pipe before child
# termination, otherwise child would block)
while ($pid = each(%children)) {
if ($children{$pid}->{"open"}) { consume_pipe($pid); }
}
# get the exit status of every terminated child process.
for (;;) {
# get the exit status of next terminated child process and
# quit the loop if there are no more deceased children
# waitpid will return -1 if there are no deceased children (or no
# children at all) at the moment; on some platforms, 0 means that
# there are children, but none of them is deceased at the moment.
# Process ID can be a positive (UNIX) or negative (windows) integer.
$pid = waitpid(-1, &WNOHANG);
if ($pid == -1 || $pid == 0) { last; }
# check if the child process has really exited (and not just stopped).
# This check will be skipped on Windows which does not have a valid
# implementation of WIFEXITED macro.
if ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?)) {
# find the child exit code
$exitcode = $? >> 8;
# if the terminated child was started as a part of 'spawn'
# action and its pipe has not been emptied yet, do it now
if ($children{$pid}->{"open"}) { consume_pipe($pid); }
# if the child exit code is zero and the child was started as
# a part of SINGLE_W_SCRIPT rule, execute action list 'Action'
if (!$exitcode && defined($children{$pid}->{"Desc"})) {
log_msg(LOG_DEBUG, "Child $pid terminated with exitcode 0");
execute_actionlist($children{$pid}->{"Action"},
$children{$pid}->{"Desc"});
# if the child exit code is non-zero and the child was started as
# a part of SINGLE_W_SCRIPT rule, execute action list 'Action2'
} elsif ($exitcode && defined($children{$pid}->{"Desc"})) {
log_msg(LOG_DEBUG,
"Child $pid terminated with non-zero exitcode $exitcode");
execute_actionlist($children{$pid}->{"Action2"},
$children{$pid}->{"Desc"});
# if the child exit code is non-zero, log a message
} elsif ($exitcode) {
log_msg(LOG_WARN,
"Child $pid terminated with non-zero exitcode $exitcode (",
$children{$pid}->{"cmd"}, ")");
}
delete $children{$pid};
}
}
}
# Parameters: par1 - name of the input file
# par2 - file position
# Action: Input file will be opened and file position will be moved to
# position par2 (-1 means "seek EOF" and 0 means "don't seek at all").
# Return the filehandle of the input file, or 'undef' if open failed.
sub open_input_file {
my($file) = $_[0];
my($fpos) = $_[1];
my($flags);
local *INPUT; # we need to use 'local *', since each time we enter
# this procedure a new filehandle must be created, that
# will be returned from this procedure for external use
# if input is stdin, duplicate it
if ($file eq "-") {
if ($WIN32) {
log_msg(LOG_ERR, "Stdin is not supported as input on Win32");
return undef;
}
while (!open(INPUT, "<&STDIN")) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't dup stdin ($!)");
return undef;
}
}
# if input file is a regular file, open it for reading
elsif (-f $file) {
while (!sysopen(INPUT, $file, O_RDONLY)) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't open input file $file ($!)");
return undef;
}
}
# if input file is a named pipe, open it both for reading and writing
# (the open would block if there are no writers at the moment, so the
# process pretends to be a writer)
elsif (-p $file) {
if ($WIN32) {
log_msg(LOG_ERR, "Named pipe is not supported as input on Win32");
return undef;
}
while (!sysopen(INPUT, $file, O_RDWR)) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't open input file $file ($!)");
return undef;
}
}
# if input file does not exist, log a debug message if -reopen_timeout
# option was given, otherwise log an error message
elsif (! -e $file) {
if ($reopen_timeout) {
log_msg(LOG_DEBUG, "Input file $file has not been created yet");
} else {
log_msg(LOG_ERR, "Input file $file does not exist!");
}
return undef;
}
# input file is of unsupported type
else {
log_msg(LOG_ERR, "Input file $file is of unsupported type!");
return undef;
}
# if INPUT filehandle is connected to a regular file
# and $fpos == -1 or $fpos > 0, seek the given position in the file
if (-f INPUT) {
if ($fpos == -1) {
while (!sysseek(INPUT, 0, SEEK_END)) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't seek EOF in input file $file ($!)");
close(INPUT);
return undef;
}
} elsif ($fpos > 0) {
while (!sysseek(INPUT, $fpos, SEEK_SET)) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't seek position $fpos in input file $file ($!)");
close(INPUT);
return undef;
}
}
}
return *INPUT;
}
# Parameters: par1 - file position
# Action: evaluate the inputfile patterns given in commandline, form the
# list of inputfiles and save it to global array @inputfiles. Each
# input file will then be opened and file position will be moved to
# position par1 (-1 means "seek EOF" and 0 means "don't seek at all").
# If -intcontexts option is active, also set up internal contexts.
sub open_input {
my($fpos) = $_[0];
my($filepat, $pattern, $cmdline_context, $context);
my($inputfile, @files, $time, $fh);
# Initialize (or clean) global arrays %inputsrc and @inputfiles
# (the keys for %inputsrc are members of global array @inputfiles)
%inputsrc = ();
@inputfiles = ();
# Initialize (or clean) the read buffer
@readbuffer = ();
# Form the list of configuration files, save it to global array
# @inputfiles, and open the files
$time = time();
foreach $filepat (@inputfilepat) {
# check if the input file pattern has a context associated with it,
# and if it does, force the -intcontexts option
if ($filepat =~ /^(.+)=(\S+)$/) {
$pattern = $1;
$cmdline_context = $2;
$intcontexts = 1;
} else {
$pattern = $filepat;
$cmdline_context = undef;
}
# interpret the pattern, and open the files that correspond to a pattern
@files = glob($pattern);
foreach $inputfile (@files) {
$fh = open_input_file($inputfile, $fpos);
if (defined($cmdline_context)) {
$context = $cmdline_context;
} else {
$context = "_FILE_EVENT_$inputfile";
}
$inputsrc{$inputfile} = { "fh" => $fh,
"open" => defined($fh),
"buffer" => "",
"scriptexec" => 0,
"checktime" => 0,
"lastopen" => $time,
"lastread" => $time,
"lines" => 0,
"context" => $context };
if (!defined($fh) && $inputfile ne "-" && ! -e $inputfile) {
$inputsrc{$inputfile}->{"read_from_start"} = 1;
}
}
push @inputfiles, @files;
}
# if -intcontexts option is active, set up internal contexts
if ($intcontexts) {
%int_contexts = ();
foreach $inputfile (@inputfiles) {
$context = $inputsrc{$inputfile}->{"context"};
if (exists($int_contexts{$context})) { next; }
$int_contexts{$context} = { "Time" => $time,
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "SEC internal",
"Aliases" => [ $context ] };
}
$context = "_INTERNAL_EVENT";
$int_contexts{$context} = { "Time" => $time,
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "SEC internal",
"Aliases" => [ $context ] };
}
}
# Parameters: par1 - name of the input file
# Action: check if input file has been removed, recreated or truncated.
# Return 1 if input file has changed and should be reopened;
# return 0 if the file has not changed or should not be
# reopened right now. If system calls of this procedure
# are interrupted by a signal, return 0 also. If system call
# on the input file fails, close the file and return undef.
sub input_shuffled {
my($file) = $_[0];
my(@oldstat, @newstat, $fpos);
# standard input is always intact (it can't be recreated or truncated)
if ($file eq "-") { return 0; }
# stat the input filehandle and exit if stat fails
@oldstat = stat($inputsrc{$file}->{"fh"});
if (!scalar(@oldstat)) {
if ($! == EINTR) { return 0; }
log_msg(LOG_ERR,
"Can't stat filehandle of input file $file ($!), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
# stat the input file and return 0 if stat fails (e.g., input file has
# been removed and not recreated yet, so we can't reopen it now)
@newstat = stat($file);
if (!scalar(@newstat)) { return 0; }
# check if i-node numbers of filehandle and input file are different
# (this check will be skipped on Windows).
if (!$WIN32 &&
($oldstat[0] != $newstat[0] || $oldstat[1] != $newstat[1])) {
log_msg(LOG_NOTICE, "Input file $file has been recreated");
return 1;
}
# Check if file size has decreased
if (-f $inputsrc{$file}->{"fh"}) {
$fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
if (!defined($fpos)) {
if ($! == EINTR) { return 0; }
log_msg(LOG_ERR,
"Can't seek filehandle of input file $file ($!), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
if ($fpos > $newstat[7]) {
log_msg(LOG_NOTICE, "Input file $file has been truncated");
return 1;
}
}
return 0;
}
# Parameters: par1 - name of the input file
# Action: read next line from the input file and return it (without '\n' at
# the end of the line). If the file has no complete line available,
# undef is returned. If read system call fails, or returns EOF and
# -notail mode is active, the file is closed and undef is returned.
sub read_line_from_file {
my($file) = $_[0];
my($pos, $line, $rin, $ret, $nbytes);
# if there is a complete line in the read buffer of the file (i.e., the
# read buffer contains at least one newline symbol), read line from there
$pos = index($inputsrc{$file}->{"buffer"}, "\n");
if ($pos != -1) {
$line = substr($inputsrc{$file}->{"buffer"}, 0, $pos);
substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = "";
return $line;
}
if (-f $inputsrc{$file}->{"fh"}) {
# try to read data from a regular file
$nbytes = sysread($inputsrc{$file}->{"fh"},
$inputsrc{$file}->{"buffer"},
$blocksize, length($inputsrc{$file}->{"buffer"}));
# check the exit value from sysread() that was saved to $nbytes:
# if $nbytes == undef, sysread() failed;
# if $nbytes == 0, we have reached EOF (no more data available);
# otherwise ($nbytes > 0) sysread() succeeded
if (!defined($nbytes)) {
# check if sysread() failed because of the caught signal (posix
# allows read(2) to be interrupted by a signal and return -1, with
# some bytes already been read into read buffer); if sysread() failed
# because of some other reason, close the file and return undef
if ($! != EINTR) {
log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
} elsif ($nbytes == 0) {
# if we have reached EOF and -tail mode is set, return undef; if
# -notail mode is active, close the file, and if the file buffer is not
# empty, return its content (bytes between the last newline in the file
# and EOF), otherwise return undef
if ($tail) { return undef; }
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
$line = $inputsrc{$file}->{"buffer"};
$inputsrc{$file}->{"buffer"} = "";
if (length($line)) { return $line; } else { return undef; }
}
} else {
# poll the input pipe for new data with select()
$rin = '';
vec($rin, fileno($inputsrc{$file}->{"fh"}), 1) = 1;
$ret = select($rin, undef, undef, 0);
if (!defined($ret) || $ret < 0) {
# if select() failed because of the caught signal, return undef,
# otherwise close the file and return undef
if ($! == EINTR) { return undef; }
log_msg(LOG_ERR,
"Input file $file select error ($!), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
} elsif ($ret == 0) {
# if we have reached EOF and -tail mode is set, return undef; if
# -notail mode is active, close the file, and if the file buffer is not
# empty, return its content (bytes between the last newline in the file
# and EOF), otherwise return undef
if ($tail) { return undef; }
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
$line = $inputsrc{$file}->{"buffer"};
$inputsrc{$file}->{"buffer"} = "";
if (length($line)) { return $line; } else { return undef; }
}
# try to read from the pipe
$nbytes = sysread($inputsrc{$file}->{"fh"},
$inputsrc{$file}->{"buffer"},
$blocksize, length($inputsrc{$file}->{"buffer"}));
# check the exit value from sysread() that was saved to $nbytes:
# if $nbytes == undef, sysread() failed;
# if $nbytes == 0, we have reached EOF (no more data available);
# otherwise ($nbytes > 0) sysread() succeeded
if (!defined($nbytes)) {
# check if sysread() failed because of the caught signal (posix
# allows read(2) to be interrupted by a signal and return -1, with
# some bytes already been read into read buffer); if sysread() failed
# because of some other reason, log an error message and return undef
if ($! != EINTR) {
log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
} elsif ($nbytes == 0) {
# if sysread() returns 0, that signals that there are no writers
# on the pipe anymore, and from now on select() always claims that
# there is some data (EOF) to be read (with named pipe we should
# never reach that condition, since we have opened it in RW-mode)
log_msg(LOG_ERR,
"Input file $file IO error (unknown pipe error), closing the file");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
}
# if the read buffer contains a newline, cut the first line from the
# read buffer and return it, otherwise return undef (even if there are
# some bytes in the buffer)
$pos = index($inputsrc{$file}->{"buffer"}, "\n");
if ($pos != -1) {
$line = substr($inputsrc{$file}->{"buffer"}, 0, $pos);
substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = "";
return $line;
}
return undef;
}
# Parameters: par1 - variable where the input line is saved
# par2 - variable where the input file name is saved
# Action: attempt to read next line from each input file, and store the
# received lines with corresponding input file names to the read
# buffer. Return the first line from the read buffer, with par1 set
# to line and par2 set to file name. If there were no new lines in
# input files, par1 is set to undef but par2 reflects the status of
# input files: value 1 means that at least one of the input files has
# new data available (although no complete line), value 0 means that
# no data were added to any of the input files since the last poll.
sub read_line {
my($line, $file);
my($time, $len, $newdata);
# check all input files and store new data to the read buffer
$newdata = 0;
$time = time();
foreach $file (@inputfiles) {
# if the check timer for the file has not expired yet, skip the file
if ($check_timeout && $time < $inputsrc{$file}->{"checktime"}) { next; }
# before reading, memorize the number of bytes in the read cache
$len = length($inputsrc{$file}->{"buffer"});
# if the input file is open, read a line from it; if the input file
# is closed, treat it as an open file with no new data available
if ($inputsrc{$file}->{"open"}) {
$line = read_line_from_file($file);
} else {
$line = undef;
}
if (defined($line)) {
# if we received a new line, write the line to the read buffer; also
# update time-related variables and call external script, if necessary
push @readbuffer, $line;
push @readbuffer, $file;
if ($input_timeout) { $inputsrc{$file}->{"lastread"} = $time; }
if ($inputsrc{$file}->{"scriptexec"}) {
log_msg(LOG_INFO,
"Input received, executing script $timeout_script 0 $file");
shell_cmd("$timeout_script 0 $file");
$inputsrc{$file}->{"scriptexec"} = 0;
}
}
else {
# if we were unable to obtain a complete line from the file but
# new bytes were stored to the read cache, don't set the check
# timer and skip shuffle and timeout checks
if ($len < length($inputsrc{$file}->{"buffer"})) {
$newdata = 1; next;
}
# if there were no new bytes in the file and -notail mode is active,
# don't set the check timer and skip shuffle and timeout checks (i.e.,
# -input_timeout, -timeout_script, -reopen_timeout, and -check_timeout
# options are ignored when -notail is set)
if (!$tail) { next; }
# if -check_timeout is set, poll the file after $check_timeout seconds
if ($check_timeout) {
$inputsrc{$file}->{"checktime"} = $time + $check_timeout;
}
# if there were no new bytes in the file and it has been shuffled,
# reopen the file and start to process it from the beginning
if ($inputsrc{$file}->{"open"} && input_shuffled($file)) {
log_msg(LOG_NOTICE,
"Shuffled $file, reopening and processing from the start");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"fh"} = open_input_file($file, 0);
$inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});
if ($reopen_timeout) { $inputsrc{$file}->{"lastopen"} = $time; }
}
# if we have waited for new bytes for more than $input_timeout
# seconds, execute external script $timeout_script with commandline
# parameters "1 <filename>"
if ($input_timeout && !$inputsrc{$file}->{"scriptexec"} &&
$time - $inputsrc{$file}->{"lastread"} >= $input_timeout) {
log_msg(LOG_INFO,
"No input, executing script $timeout_script 1 $file");
shell_cmd("$timeout_script 1 $file");
$inputsrc{$file}->{"scriptexec"} = 1;
}
# if we have waited for new bytes for more than $reopen_timeout
# seconds, reopen the input file
if ($reopen_timeout && !$inputsrc{$file}->{"open"} &&
$time - $inputsrc{$file}->{"lastopen"} >= $reopen_timeout) {
log_msg(LOG_DEBUG, "Attempting to (re)open $file");
if (exists($inputsrc{$file}->{"read_from_start"})) {
$inputsrc{$file}->{"fh"} = open_input_file($file, 0);
if (defined($inputsrc{$file}->{"fh"})) {
delete $inputsrc{$file}->{"read_from_start"};
}
} else {
$inputsrc{$file}->{"fh"} = open_input_file($file, -1);
}
$inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"lastopen"} = $time;
}
}
}
# if we succeeded to read new data and write it to the read buffer,
# return the first line from the buffer; otherwise return undef
if (scalar(@readbuffer)) {
$_[0] = shift @readbuffer;
$_[1] = shift @readbuffer;
} else {
$_[0] = undef;
$_[1] = $newdata;
}
}
###################################################
# Functions related to signal reception and sending
###################################################
# Parameters: -
# Action: check whether signals have arrived and process them
sub check_signals {
my($file, @file_list);
my(@allkeys, @keys);
# if SIGHUP has arrived, do a full restart of SEC
if ($refresh) {
log_msg(LOG_NOTICE, "SIGHUP received: full restart of SEC");
# terminate child processes
child_cleanup();
# clear correlation operations, contexts and user-defined variables
%corr_list = ();
%context_list = ();
%variables = ();
# clear pending events
@pending_events = ();
# close input sources
foreach $file (@inputfiles) {
if ($inputsrc{$file}->{"open"}) { close($inputsrc{$file}->{"fh"}); }
}
# close the logfile and connection to the system logger
if ($logfile) { close(LOGFILE); }
if ($syslogf) { eval { Sys::Syslog::closelog() }; }
# now the SEC internal state has been cleared, input sources and log
# handles closed - re-read SEC command line and resource file options
read_options();
# open the logfile and connection to the system logger
if ($logfile) { open_logfile($logfile); }
if ($syslogf) { open_syslog($syslogf); }
# read configuration from SEC rule files
read_config();
# open input sources and resize the input buffer
open_input(-1);
resize_input_buffer();
# if -intevents flag was specified, generate the SEC_RESTART event
if ($intevents) { internal_event("SEC_RESTART"); }
# set the signal flag back to zero
$refresh = 0;
}
# if SIGABRT has arrived, do a soft restart of SEC
if ($softrefresh) {
log_msg(LOG_NOTICE, "SIGABRT received: soft restart of SEC");
# close input sources
foreach $file (@inputfiles) {
if ($inputsrc{$file}->{"open"}) { close($inputsrc{$file}->{"fh"}); }
}
# close the logfile and connection to the system logger
if ($logfile) { close(LOGFILE); }
if ($syslogf) { eval { Sys::Syslog::closelog() }; }
# now input sources and log handles have been closed -
# re-read SEC command line and resource file options
read_options();
# open the logfile and connection to the system logger
if ($logfile) { open_logfile($logfile); }
if ($syslogf) { open_syslog($syslogf); }
# read configuration from SEC rule files that are either new or
# have been modified, and store to the array @file_list the names
# of files that have been modified or removed
soft_read_config(\@file_list);
# clear event correlation operations related to the modified and
# removed configuration files
@allkeys = keys %corr_list;
foreach $file (@file_list) {
@keys = grep($corr_list{$_}->{"File"} eq $file, @allkeys);
delete @corr_list{@keys};
}
# open input sources and resize the input buffer
open_input(-1);
resize_input_buffer();
# if -intevents flag was specified, generate the SEC_SOFTRESTART event
if ($intevents) { internal_event("SEC_SOFTRESTART"); }
# set the signal flag back to zero
$softrefresh = 0;
}
# if SIGUSR1 has arrived, create the dump file
if ($dumpdata) {
log_msg(LOG_NOTICE, "SIGUSR1 received: dumping data to $dumpfile");
# write info about SEC state to the dump file
dump_data();
# set the signal flag back to zero
$dumpdata = 0;
}
# if SIGUSR2 has arrived, restart logging
if ($openlog) {
log_msg(LOG_NOTICE, "SIGUSR2 received: restarting logging");
# reopen the logfile and connection to the system logger
if ($logfile) {
close(LOGFILE);
open_logfile($logfile);
}
if ($syslogf) {
eval { Sys::Syslog::closelog() };
open_syslog($syslogf);
}
# set the signal flag back to zero
$openlog = 0;
}
# if SIGTERM has arrived, shutdown SEC
if ($terminate) {
log_msg(LOG_NOTICE, "SIGTERM received: shutting down SEC");
# If -intevents flag was specified, generate the SEC_SHUTDOWN event.
# Note that the $terminate flag will be set back to zero, as if
# SEC_SHUTDOWN event was generated before SIGTERM under normal circum-
# stances (when $terminate is set, SEC does not fork any new processes).
# Note also, that after generating SEC_SHUTDOWN event, SEC will sleep for
# TERMTIMEOUT seconds, so that child processes that were triggered by
# SEC_SHUTDOWN have time to create a signal handler for SIGTERM if needed.
if ($intevents) {
$terminate = 0;
internal_event("SEC_SHUTDOWN");
sleep(TERMTIMEOUT);
}
# final shutdown procedures
child_cleanup();
exit(0);
}
}
# Parameters: -
# Action: terminate child processes
sub child_cleanup {
my($pid);
while($pid = each(%children)) {
log_msg(LOG_NOTICE, "Sending SIGTERM to process $pid");
kill('TERM', $pid);
}
}
# Parameters: -
# Action: on arrival of SIGHUP set flag $refresh
sub hup_handler {
$SIG{HUP} = \&hup_handler;
$refresh = 1;
}
# Parameters: -
# Action: on arrival of SIGABRT set flag $softrefresh
sub abrt_handler {
$SIG{ABRT} = \&abrt_handler;
$softrefresh = 1;
}
# Parameters: -
# Action: on arrival of SIGUSR1 set flag $dumpdata
sub usr1_handler {
$SIG{USR1} = \&usr1_handler;
$dumpdata = 1;
}
# Parameters: -
# Action: on arrival of SIGUSR2 set flag $openlog
sub usr2_handler {
$SIG{USR2} = \&usr2_handler;
$openlog = 1;
}
# Parameters: -
# Action: on arrival of SIGTERM clean things up and exit
sub term_handler {
$SIG{TERM} = \&term_handler;
$terminate = 1;
}
##########################################################
# Functions related to daemonization and option processing
##########################################################
# Parameters: -
# Action: daemonize the process
sub daemonize {
local $SIG{HUP} = 'IGNORE'; # ignore SIGHUP inside this function
my($pid);
# -detach is not supported on Windows
if ($WIN32) {
log_msg(LOG_CRIT, "'-detach' option is not supported on Win32");
exit(1);
}
# if stdin was specified as input, we can't become a daemon
if (grep($_ eq "-", @inputfiles)) {
log_msg(LOG_CRIT,
"Can't become a daemon (stdin is specified as input), exiting!");
exit(1);
}
# fork a new copy of the process and exit from the parent
$pid = fork();
if (!defined($pid)) {
log_msg(LOG_CRIT,
"Can't fork a new process for daemonization ($!), exiting!");
exit(1);
}
if ($pid) { exit(0); }
# create a new session and process group
if (!POSIX::setsid()) {
log_msg(LOG_CRIT, "Can't start a new session ($!), exiting!");
exit(1);
}
# fork a second copy of the process and exit from the parent - the parent
# as a session leader might deliver the SIGHUP signal to child when it
# exits, but SIGHUP is ignored inside this function
$pid = fork();
if (!defined($pid)) {
log_msg(LOG_CRIT,
"Can't fork a new process for daemonization ($!), exiting!");
exit(1);
}
if ($pid) { exit(0); }
# connect stdin, stdout, and stderr to /dev/null
if (!open(STDIN, '/dev/null')) {
log_msg(LOG_CRIT, "Can't connect stdin to /dev/null ($!), exiting!");
exit(1);
}
if (!open(STDOUT, '>/dev/null')) {
log_msg(LOG_CRIT, "Can't connect stdout to /dev/null ($!), exiting!");
exit(1);
}
if (!open(STDERR, '>&STDOUT')) {
log_msg(LOG_CRIT,
"Can't connect stderr to stdout with dup ($!), exiting!");
exit(1);
}
log_msg(LOG_DEBUG, "Daemonization complete");
}
# Parameters: -
# Action: read and process options from command line and resource file
sub read_options {
my(@argv_backup, $option);
# back up the @ARGV array
@argv_backup = @ARGV;
# open the file pointed by the SECRC environment variable and
# read options from that file; empty lines and lines starting
# with the #-symbol are ignored, rest of the lines are treated
# as SEC command line options and pushed into @ARGV with
# leading and trailing whitespace removed
if (exists($ENV{"SECRC"})) {
if (open(SECRC, $ENV{"SECRC"})) {
while (<SECRC>) {
if (/^\s*(.*\S)/) {
$option = $1;
if (index($option, '#') == 0) { next; }
push @ARGV, $option;
}
}
close(SECRC);
$rcfile_status = $ENV{"SECRC"};
} else {
$rcfile_status = $ENV{"SECRC"} . " - open failed ($!)";
}
} else { $rcfile_status = "none"; }
# set the $sec_options global variable
$sec_options = join(" ", @ARGV);
# (re)set option variables to default values
@conffilepat = ();
@inputfilepat = ();
$input_timeout = 0;
$timeout_script = "";
$reopen_timeout = 0;
$check_timeout = 0;
$poll_timeout = 0.1;
$blocksize = 1024;
$bufsize = 10;
$evstoresize = 0;
$cleantime = 1;
$logfile = "";
$syslogf = "";
$debuglevel = 6;
$pidfile = "";
$dumpfile = "/tmp/sec.dump";
$quoting = 0;
$tail = 1;
$fromstart = 0;
$detach = 0;
$intevents = 0;
$intcontexts = 0;
$testonly = 0;
$help = 0;
$version = 0;
# parse the options given in command line and in SEC resource file
GetOptions( "conf=s" => \@conffilepat,
"input=s" => \@inputfilepat,
"input_timeout=i" => \$input_timeout,
"timeout_script=s" => \$timeout_script,
"reopen_timeout=i" => \$reopen_timeout,
"check_timeout=i" => \$check_timeout,
"poll_timeout=f" => \$poll_timeout,
"blocksize=i" => \$blocksize,
"bufsize=i" => \$bufsize,
"evstoresize=i" => \$evstoresize,
"cleantime=i" => \$cleantime,
"log=s" => \$logfile,
"syslog=s" => \$syslogf,
"debug=i", \$debuglevel,
"pid=s" => \$pidfile,
"dump=s" => \$dumpfile,
"quoting!" => \$quoting,
"tail!" => \$tail,
"fromstart!" => \$fromstart,
"detach!" => \$detach,
"intevents!" => \$intevents,
"intcontexts!" => \$intcontexts,
"testonly!" => \$testonly,
"help|?" => \$help,
"version" => \$version );
# check the values received from command line and resource file
# and set option variables back to defaults, if necessary
if (!$timeout_script || $input_timeout < 0) { $input_timeout = 0; }
if ($reopen_timeout < 0) { $reopen_timeout = 0; }
if ($check_timeout < 0) { $check_timeout = 0; }
if ($poll_timeout < 0) { $poll_timeout = 0.1; }
if ($blocksize <= 0) { $blocksize = 1024; }
if ($bufsize <= 0) { $bufsize = 10; }
if ($evstoresize < 0) { $evstoresize = 0; }
if ($cleantime < 0) { $cleantime = 1; }
if ($debuglevel < 1 || $debuglevel > 6) { $debuglevel = 6; }
# restore the @ARGV array
@ARGV = @argv_backup;
}
##################################################################
# ------------------------- MAIN PROGRAM -------------------------
##################################################################
### Read and process SEC options from command line and resource file
read_options();
### If requested, print usage/version info and exit
if ($help) {
print $SEC_USAGE;
exit(0);
}
if ($version) {
print $SEC_VERSION, "\n";
print $SEC_COPYRIGHT, "\n";
print $SEC_LICENSE;
exit(0);
}
### Open logfile
if ($logfile) { open_logfile($logfile); }
if ($syslogf) { open_syslog($syslogf); }
log_msg(LOG_NOTICE, "$SEC_VERSION");
# If -detach flag was specified, chdir to / for not disturbing future
# unmount of current filesystem. Must be done before read_config() to
# receive error messages about scripts that would not be found at runtime
if ($detach) {
log_msg(LOG_NOTICE, "Changing working directory to /");
chdir('/');
}
### Read in configuration
my $config_ok = read_config();
if ($testonly) {
if ($config_ok) { exit(0); } else { exit(1); }
}
### Open input sources
if ($fromstart) { open_input(0); }
elsif ($tail) { open_input(-1); }
else { open_input(0); }
### Daemonize the process, if -detach flag was specified
if ($detach) { daemonize(); }
### Create pidfile - must be done after daemonization
if ($pidfile) {
if (open(PIDFILE, ">$pidfile")) {
print PIDFILE "$$\n";
close(PIDFILE);
} else {
log_msg(LOG_CRIT,
"Can't open pidfile $pidfile for writing ($!), exiting!");
exit(1);
}
}
### Set signal handlers
$refresh = 0;
$SIG{HUP} = \&hup_handler;
$softrefresh = 0;
$SIG{ABRT} = \&abrt_handler;
$dumpdata = 0;
$SIG{USR1} = \&usr1_handler;
$openlog = 0;
$SIG{USR2} = \&usr2_handler;
$terminate = 0;
$SIG{TERM} = \&term_handler;
### Set various global variables
$lastcleanuptime = $startuptime = time();
$processedlines = 0;
### Initialize input buffer
for (my $i = 0; $i < $bufsize; ++$i) {
$input_buffer[$i] = "";
$input_sources[$i] = "";
}
$bufpos = $bufsize - 1;
### Initialize correlation list, context list,
### buffer list, and child process list
%corr_list = ();
%context_list = ();
%children = ();
### Initialize event buffers
@events = ();
@pending_events = ();
### If -intevents flag was specified, create generate the SEC_STARTUP event
if ($intevents) { internal_event("SEC_STARTUP"); }
### The main loop - read lines from input stream and process them
for (;;) {
my($line, $file, $ret);
my($context, $conffile);
# if there are pending events in the event buffer or the read buffer,
# read new line from there, otherwise read new line from input stream.
if (scalar(@events)) {
$line = shift @events;
$file = undef;
} elsif (scalar(@readbuffer)) {
$line = shift @readbuffer;
$file = shift @readbuffer;
} else {
read_line($line, $file);
}
if (defined($line)) {
if ($intcontexts) {
if (defined($file)) { $context = $inputsrc{$file}->{"context"}; }
else { $context = "_INTERNAL_EVENT"; }
$context_list{$context} = $int_contexts{$context};
}
# update input buffer (it is implemented as a circular buffer, since
# according to benchmarks an array queue using shift and push is slower)
$bufpos = ($bufpos + 1) % $bufsize;
$input_buffer[$bufpos] = $line;
$input_sources[$bufpos] = $file;
# process rules from configuration files
foreach $conffile (@conffiles) { process_rules($conffile); }
if ($intcontexts) { delete $context_list{$context}; }
if (defined($file)) { ++$inputsrc{$file}->{"lines"}; }
++$processedlines;
} elsif (!$file) {
# if we didn't get new data and -tail option was specified, sleep
# for $poll_timeout seconds; if -notail option is active and all
# input files have been closed, exit
if ($tail) {
# sleep with select()
$ret = select(undef, undef, undef, $poll_timeout);
if ((!defined($ret) || $ret < 0) && $! != EINTR) {
log_msg(LOG_CRIT, "Select error ($!), exiting!");
child_cleanup();
exit(1);
}
} elsif (!grep($inputsrc{$_}->{"open"}, @inputfiles)) {
# after generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT
# seconds, so that child processes that were triggered by SEC_SHUTDOWN
# have time to create a signal handler for SIGTERM if they wish
if ($intevents) {
internal_event("SEC_SHUTDOWN");
sleep(TERMTIMEOUT);
}
child_cleanup();
exit(0);
}
}
# search all lists, performing timed tasks associated with elements
# and removing obsolete elements
if (time() - $lastcleanuptime >= $cleantime) {
process_lists();
$lastcleanuptime = time();
}
# manage child processes
if (scalar(%children)) { check_children(); }
# check signal flags
check_signals();
}
syntax highlighted by Code2HTML, v. 0.9.1