|
Server IP : 172.16.15.8 / Your IP : 3.16.51.237 Web Server : Apache System : Linux zeus.vwu.edu 4.18.0-553.27.1.el8_10.x86_64 #1 SMP Wed Nov 6 14:29:02 UTC 2024 x86_64 User : apache ( 48) PHP Version : 7.2.24 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON Directory (0555) : /../proc/26/../509/../569/../480/../985/../45/../45/../35/../665/../4/../48/../217/../../bin/ |
| [ Home ] | [ C0mmand ] | [ Upload File ] |
|---|
#!/usr/bin/perl -w
#
# SEC (Simple Event Correlator) 2.9.3 - sec
# Copyright (C) 2000-2024 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, $listcontext) = @_;
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(
@actioncopyfunc
@actionsubstfunc
$blocksize
$bufpos
$bufsize
@calendar
%cfset2cfile
$check_timeout
%children
$childterm
$cleantime
@conffilepat
@conffiles
%config_ltimes
%config_mtimes
%config_options
%configuration
%context_list
%corr_list
$debuglevel
$debuglevelinc
$detach
$dumpdata
$dumpfile
$dumpfjson
$dumpfts
%dyninputfiles
@events
%event_buffer
$evstoresize
@execactionfunc
$fromstart
@groupnames
$help
@inputfilepat
@inputfiles
%inputsrc
@input_buffer
%input_buffers
@input_sources
$input_timeout
$intcontextname
$intcontexts
$intevents
$int_context
$JSONAVAIL
$jointbuf
$keepopen
$lastcleanuptime
$lastconfigload
$logfile
$loghandle
$logopen
@maincfiles
@matchegrpfunc
@matchfunc
@matchrulefunc
$openlog
%output_files
%output_tcpconn
%output_tcpsock
%output_udgram
%output_udpsock
%output_ustrconn
%output_ustream
@pending_events
$pidfile
%pmatch_cache
$poll_timeout
$processedlines
@processrulefunc
$quoting
$rcfile_status
@readbuffer
$refresh
$reopen_timeout
$ruleperf
$rwfifo
$SEC_COPYRIGHT
$SEC_LICENSE
$SEC_USAGE
$SEC_VERSION
$SYSLOGAVAIL
$sec_options
$sigreceived
$socket_timeout
$softrefresh
$startuptime
$syslogf
$syslogopen
$tail
%terminate
$testonly
$timeout_script
$timevar_update
$umask
$username
%variables
$version
$WIN32
);
##### Load modules and set some global variables #####
use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END
setsid ctermid getpgrp tcgetpgrp setuid setgid strftime);
use Getopt::Long;
use Fcntl;
use Socket;
use IO::Handle;
# check if Sys::Syslog and JSON::PP modules are available
$SYSLOGAVAIL = eval { require Sys::Syslog };
$JSONAVAIL = eval { require JSON::PP };
# 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.9.3";
$SEC_COPYRIGHT = "Copyright (C) 2000-2024 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>
--socket-timeout=<socket 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>
--user=<username>
--group=<groupname> ...
--umask=<mode>
--ruleperf, --noruleperf
--dumpfts, --nodumpfts
--dumpfjson, --nodumpfjson
--quoting, --noquoting
--tail, --notail
--fromstart, --nofromstart
--detach, --nodetach
--jointbuf, --nojointbuf
--keepopen, --nokeepopen
--rwfifo, --norwfifo
--childterm, --nochildterm
--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 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 EVENT_GROUP => 7;
use constant SUPPRESS => 8;
use constant CALENDAR => 9;
use constant JUMP => 10;
use constant SUBSTR => 0;
use constant REGEXP => 1;
use constant PERLFUNC => 2;
use constant CACHED => 3;
use constant NSUBSTR => 4;
use constant NREGEXP => 5;
use constant NPERLFUNC => 6;
use constant NCACHED => 7;
use constant TVALUE => 8;
use constant DONTCONT => 0;
use constant TAKENEXT => 1;
use constant GOTO => 2;
use constant ENDMATCH => 3;
use constant NONE => 0;
use constant LOGONLY => 1;
use constant WRITE => 2;
use constant WRITEN => 3;
use constant CLOSEF => 4;
use constant OWRITECL => 5;
use constant UDGRAM => 6;
use constant CLOSEUDGR => 7;
use constant USTREAM => 8;
use constant CLOSEUSTR => 9;
use constant UDPSOCK => 10;
use constant CLOSEUDP => 11;
use constant TCPSOCK => 12;
use constant CLOSETCP => 13;
use constant SHELLCOMMAND => 14;
use constant COMMANDEXEC => 15;
use constant SPAWN => 16;
use constant SPAWNEXEC => 17;
use constant CSPAWN => 18;
use constant CSPAWNEXEC => 19;
use constant PIPE => 20;
use constant PIPEEXEC => 21;
use constant CREATECONTEXT => 22;
use constant DELETECONTEXT => 23;
use constant OBSOLETECONTEXT => 24;
use constant SETCONTEXT => 25;
use constant ALIAS => 26;
use constant UNALIAS => 27;
use constant ADD => 28;
use constant PREPEND => 29;
use constant FILL => 30;
use constant REPORT => 31;
use constant REPORTEXEC => 32;
use constant COPYCONTEXT => 33;
use constant EMPTYCONTEXT => 34;
use constant POP => 35;
use constant SHIFT => 36;
use constant EXISTS => 37;
use constant GETSIZE => 38;
use constant GETALIASES => 39;
use constant GETLIFETIME => 40;
use constant SETLIFETIME => 41;
use constant GETCTIME => 42;
use constant SETCTIME => 43;
use constant EVENT => 44;
use constant TEVENT => 45;
use constant CEVENT => 46;
use constant RESET => 47;
use constant GETWINPOS => 48;
use constant SETWINPOS => 49;
use constant ASSIGN => 50;
use constant ASSIGNSQ => 51;
use constant FREE => 52;
use constant EVAL => 53;
use constant CALL => 54;
use constant LCALL => 55;
use constant REWRITE => 56;
use constant ADDINPUT => 57;
use constant DROPINPUT => 58;
use constant SIGEMUL => 59;
use constant VARIABLESET => 60;
use constant IF => 100;
use constant WHILE => 101;
use constant BREAK => 102;
use constant CONTINUE => 103;
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 CCODE2 => 7;
use constant VARSET => 8;
use constant EXPRSYMBOL => "\0";
use constant LOG_WITHOUT_LEVEL => 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 => {
0 => "notice",
1 => "crit",
2 => "err",
3 => "warning",
4 => "notice",
5 => "info",
6 => "debug"
};
use constant SEPARATOR => " | ";
use constant TERMTIMEOUT => 3;
use constant BATCHREADLIMIT => 8192;
use constant SECEVENT_INT_CONTEXT => "SEC_INTERNAL_EVENT";
use constant SYNEVENT_INT_CONTEXT => "_INTERNAL_EVENT";
use constant FILEVENT_INT_CONTEXT_PREF => "_FILE_EVENT_";
use constant DEFAULT_POLLTIMEOUT => 0.1;
use constant DEFAULT_SOCKETTIMEOUT => 60;
use constant DEFAULT_BLOCKSIZE => 8192;
use constant DEFAULT_CLEANTIME => 1;
use constant DEFAULT_DUMPFILE => "/tmp/sec.dump";
###############################################################
# ------------------------- 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 $loghandle.
sub open_logfile {
my($logfile) = $_[0];
if (open($loghandle, ">>$logfile")) {
select($loghandle);
$| = 1;
select(STDOUT);
$logopen = 1;
} else {
print STDERR "Can't open logfile $logfile ($!)\n";
$logopen = 0;
}
}
# Parameters: par1 - syslog facility
# Action: open connection to the system logger with the facility par1.
sub open_syslog {
my($facility) = $_[0];
my($progname);
$progname = $0;
$progname =~ s/.*\///;
eval { Sys::Syslog::openlog($progname, "pid", $facility) };
if ($@) {
print STDERR "Can't connect to syslog ($@)\n";
$syslogopen = 0;
return;
}
$syslogopen = 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 $loghandle 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 (!$logopen && !$syslogopen && ! -t STDERR) { return; }
$msg = join(" ", @_);
if (-t STDERR) { print STDERR "$msg\n"; }
if ($logopen) {
$ltime = localtime(time());
print $loghandle "$ltime: $msg\n";
}
# if call to syslog() fails (e.g., because syslog daemon is going through
# restart), older versions of Sys::Syslog will die, thus we use eval
if ($syslogopen) {
eval { Sys::Syslog::syslog(SYSLOG_LEVELS->{$level}, $msg) };
}
}
#######################################################
# Functions related to configuration file(s) processing
#######################################################
# 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 - string that is checked for match variables
# par2, .. - one or more tokens that match variables begin with
# Action: return 1 if the string par1 contains match variables, 0 otherwise
sub contains_matchvars {
my($string) = shift @_;
my($token, $string2, %subst);
# invoke subst_string() function for the input string and empty match
# value hash - if the string contains match variables, they are replaced
# with empty strings, and the result is different from the original string
foreach $token (@_) {
$string2 = $string;
subst_string(\%subst, $string2, $token);
if ($string ne $string2) { return 1; }
}
return 0;
}
# Parameters: par1 - reference to a context expression
# par2, .. - one or more tokens that match variables begin with
# Action: return 1 if expression par1 contains match variables, 0 otherwise
sub volatile_context {
my($ref) = shift @_;
my($i, $j, $elem);
$i = 0;
$j = scalar(@{$ref});
while ($i < $j) {
if ($ref->[$i] == OPERAND || $ref->[$i] == ECODE
|| $ref->[$i] == VARSET) {
if (contains_matchvars($ref->[$i+1], @_)) { return 1; }
$i += 2;
}
elsif ($ref->[$i] == EXPRESSION) {
if (volatile_context($ref->[$i+1], @_)) { return 1; }
$i += 2;
}
elsif ($ref->[$i] == CCODE || $ref->[$i] == CCODE2) {
foreach $elem (@{$ref->[$i+1]}) {
if (contains_matchvars($elem, @_)) { return 1; }
}
$i += 3;
}
else { ++$i; }
}
return 0;
}
# 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, $expr_ref) = @_;
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 with
# an optional jump label 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, $conffile, $lineno) = @_;
if (uc($continue) eq "TAKENEXT") { return (TAKENEXT, undef); }
elsif (uc($continue) eq "DONTCONT") { return (DONTCONT, undef); }
elsif (uc($continue) eq "ENDMATCH") { return (ENDMATCH, undef); }
elsif ($continue =~ /^goto\s+(.*\S)/i) { return (GOTO, $1); }
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 pattern is a second regular expression pattern of Pair rule which
# contains match variables, the expression will not be compiled and
# a corresponding flag is added to the return list.
# 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, $pat, $conffile, $lineno, $fptype) = @_;
my($negate, $lines, $pat2, $ncomp);
my($evalok, $retval);
if ($pattype =~ /^(n?)regexp(?:0*([1-9][0-9]*))?$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (defined($2)) { $lines = $2; } else { $lines = 1; }
if ($bufsize && $lines > $bufsize) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Pattern type '$pattype' is designed to match $lines lines,",
"please set --bufsize command line option to at least $lines");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
if (!defined($fptype) || $fptype == TVALUE || $fptype == SUBSTR ||
$fptype == NSUBSTR || !contains_matchvars($pat, '$')) {
$pat2 = eval { qr/$pat/ };
if ($@) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid regular expression '$pat':", $@);
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
} else {
$pat2 = $pat;
$ncomp = 1;
}
if ($negate) { return (NREGEXP, $lines, $pat2, $ncomp); }
else { return (REGEXP, $lines, $pat2, $ncomp); }
} elsif ($pattype =~ /^(n?)substr(?:0*([1-9][0-9]*))?$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (defined($2)) { $lines = $2; } else { $lines = 1; }
if ($bufsize && $lines > $bufsize) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Pattern type '$pattype' is designed to match $lines lines,",
"please set --bufsize command line option to at least $lines");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
subst_specchar($pat);
if ($negate) { return (NSUBSTR, $lines, $pat); }
else { return (SUBSTR, $lines, $pat); }
} elsif ($pattype =~ /^(n?)perlfunc(?:0*([1-9][0-9]*))?$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if (defined($2)) { $lines = $2; } else { $lines = 1; }
if ($bufsize && $lines > $bufsize) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Pattern type '$pattype' is designed to match $lines lines,",
"please set --bufsize command line option to at least $lines");
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', eval didn't return a code reference:",
defined($retval)?"$retval":"undef");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
if ($negate) { return (NPERLFUNC, $lines, $retval); }
else { return (PERLFUNC, $lines, $retval); }
} elsif ($pattype =~ /^(n?)cached$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
if ($pat !~ /^[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid cached pattern name '$pat':",
"the name does not have the form",
"<letter>[<letter>|<digit>|<underscore>]...");
return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
}
if ($negate) { return (NCACHED, 1, $pat); }
else { return (CACHED, 1, $pat); }
} 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 - pattern type
# par2 - variable map (string)
# par3 - reference to the variable map hash
# par4 - the name of the configuration file
# par5 - line number in configuration file
# Action: variable map par2 will be analyzed and saved into the hash par3.
# If no errors are detected, 1 is returned. Otherwise error message
# about improper line par5 in configuration file will be logged,
# and 0 is returned. If the pattern type does not assume a variable
# map (e.g., TValue), par3 will be set to empty hash, a warning is
# logged and 1 is returned.
sub analyze_varmap {
my($pattype, $varmap, $maphash_ref, $conffile, $lineno) = @_;
my(@varmap, $mapping);
%{$maphash_ref} = ();
if ($pattype != REGEXP && $pattype != PERLFUNC) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Variable maps are supported for RegExp and PerlFunc patterns only,",
"ignoring variable map '$varmap'");
return 1;
}
@varmap = split(/\s*;\s*/, $varmap);
foreach $mapping (@varmap) {
if ($mapping =~ /^\s*([[:alpha:]]\w*)(?:\s*=\s*0*([0-9]+))?\s*$/) {
$maphash_ref->{"$1"} = $2;
} else {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid variable map '$varmap':",
"the variable mapping '$mapping' does not have the form",
"<letter>[<letter>|<digit>|<underscore>]... [= <number>]");
return 0;
}
}
return 1;
}
# Parameters: par1 - event group pattern type (string)
# par2 - event group pattern
# par3 - the name of the configuration file
# par4 - line number in configuration file
# Action: par1 and par2 will be analyzed and tuple of integers
# (pattern type, compiled pattern) will be returned.
# If errors are found when analyzing par1 and par2, error message
# about improper line par4 in configuration file will be logged.
sub analyze_eventgroup_pattern {
my($pattype, $pat, $conffile, $lineno) = @_;
my($negate, $pat2);
my($evalok, $retval);
if ($pattype =~ /^(n?)regexp$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
$pat2 = eval { qr/$pat/ };
if ($@) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid regular expression '$pat':", $@);
return (INVALIDVALUE, INVALIDVALUE);
}
if ($negate) { return (NREGEXP, $pat2); }
else { return (REGEXP, $pat2); }
} elsif ($pattype =~ /^(n?)substr$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
subst_specchar($pat);
if ($negate) { return (NSUBSTR, $pat); }
else { return (SUBSTR, $pat); }
} elsif ($pattype =~ /^(n?)perlfunc$/i) {
if (length($1)) { $negate = 1; } else { $negate = 0; }
($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', eval didn't return a code reference:",
defined($retval)?"$retval":"undef");
return (INVALIDVALUE, INVALIDVALUE);
}
if ($negate) { return (NPERLFUNC, $retval); }
else { return (PERLFUNC, $retval); }
}
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid event group pattern type '$pattype'");
return (INVALIDVALUE, INVALIDVALUE);
}
# Parameters: par1, par2, .. - strings
# Action: for each string, remove the outer pair of parens and backslashes
# from the front of other parens
sub process_action_parens {
my($string);
foreach $string (@_) {
if ($string =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $string = $1; }
$string =~ s/\\([()])/$1/g;
}
}
# Parameters: par1 - action
# par2 - the name of the configuration file
# par3 - line number in configuration file
# par4 - rule ID
# par5 - action with masked subexpressions
# par6 - list of subexpressions
# 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, $conffile, $lineno, $ruleid, $action2, $list) = @_;
my($keyword, $file, $fpos, $peer, $cmdline, $signal);
my($sign, $rule, $count);
my($actionlist, @action);
my($actionlist2, @action2);
my($createafter, $event, $timestamp);
my($lifetime, $context, $alias, $entry);
my($variable, $value, $code, $codeptr, $params, $evalok, $op);
if ($action =~ /^none$/i) { return NONE; }
elsif ($action =~ /^logonly(?:\s+(.*\S))?$/i) {
$event = defined($1)?$1:"";
process_action_parens($event);
if (!length($event)) { $event = "%s"; }
return (LOGONLY, $event);
}
elsif ($action =~ /^(write|writen|owritecl|udgram|ustream)\s+(\S+)(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$file = $2;
$event = defined($3)?$3:"";
if ($WIN32 && ($keyword eq "udgram" || $keyword eq "ustream")) {
log_msg(LOG_ERR, "$keyword action is not supported on Win32");
return INVALIDVALUE;
}
process_action_parens($file, $event);
if (!length($file)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty filename given for $keyword action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
if ($keyword eq "write") { return (WRITE, $file, $event); }
elsif ($keyword eq "writen") { return (WRITEN, $file, $event); }
elsif ($keyword eq "owritecl") { return (OWRITECL, $file, $event); }
elsif ($keyword eq "udgram") { return (UDGRAM, $file, $event); }
else { return (USTREAM, $file, $event); }
}
elsif ($action =~ /^(closef|closeudgr|closeustr|dropinput)\s+(\S+)$/i) {
$keyword = lc($1);
$file = $2;
if ($WIN32 && ($keyword eq "closeudgr" || $keyword eq "closeustr")) {
log_msg(LOG_ERR, "$keyword action is not supported on Win32");
return INVALIDVALUE;
}
process_action_parens($file);
if (!length($file)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty filename given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "closef") { return (CLOSEF, $file); }
elsif ($keyword eq "closeudgr") { return (CLOSEUDGR, $file); }
elsif ($keyword eq "closeustr") { return (CLOSEUSTR, $file); }
else { return (DROPINPUT, $file); }
}
elsif ($action =~ /^(udpsock|tcpsock)\s+(\S+)(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$peer = $2;
$event = defined($3)?$3:"";
process_action_parens($peer, $event);
if (!length($peer)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty peername given for $keyword action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
if ($keyword eq "udpsock") { return (UDPSOCK, $peer, $event); }
else { return (TCPSOCK, $peer, $event); }
}
elsif ($action =~ /^(closeudp|closetcp)\s+(\S+)$/i) {
$keyword = lc($1);
$peer = $2;
process_action_parens($peer);
if (!length($peer)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty peername given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "closeudp") { return (CLOSEUDP, $peer); }
else { return (CLOSETCP, $peer); }
}
elsif ($action =~ /^(shellcmd|cmdexec)\s+(.*\S)$/i) {
$keyword = lc($1);
$cmdline = $2;
process_action_parens($cmdline);
if (!length($cmdline)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty commandline given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "shellcmd") { return (SHELLCOMMAND, $cmdline); }
else { return (COMMANDEXEC, [ split(' ', $cmdline) ]); }
}
elsif ($action =~ /^(spawn|spawnexec)\s+(.*\S)$/i) {
$keyword = lc($1);
$cmdline = $2;
if ($WIN32) {
log_msg(LOG_ERR, "$keyword action is not supported on Win32");
return INVALIDVALUE;
}
process_action_parens($cmdline);
if (!length($cmdline)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty commandline given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "spawn") { return (SPAWN, $cmdline); }
else { return (SPAWNEXEC, [ split(' ', $cmdline) ]); }
}
elsif ($action =~ /^(cspawn|cspawnexec)\s+(\S+)\s+(.*\S)$/i) {
$keyword = lc($1);
$context = $2;
$cmdline = $3;
if ($WIN32) {
log_msg(LOG_ERR, "$keyword action is not supported on Win32");
return INVALIDVALUE;
}
process_action_parens($context, $cmdline);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for $keyword action");
return INVALIDVALUE;
}
if (!length($cmdline)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty commandline given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "cspawn") { return (CSPAWN, $context, $cmdline); }
else { return (CSPAWNEXEC, $context, [ split(' ', $cmdline) ]); }
}
elsif ($action =~ /^(pipe|pipeexec)\s+'([^']*)'(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$event = $2;
$cmdline = defined($3)?$3:"";
process_action_parens($event, $cmdline);
if (!length($event)) { $event = "%s"; }
# note that if commandline is not provided, $cmdline is set to
# empty string, and in this case split() produces an empty list
if ($keyword eq "pipe") { return (PIPE, $event, $cmdline); }
else { return (PIPEEXEC, $event, [ split(' ', $cmdline) ]); }
}
elsif ($action =~ /^create(?:\s+(\S+)(?:\s+(\S+)(?:\s+(.*\S))?)?)?$/i) {
$context = defined($1)?$1:"";
$lifetime = defined($2)?$2:"";
$actionlist = defined($3)?$3:"";
process_action_parens($context, $lifetime);
# strip outer parentheses from actionlist if they exist
if ($actionlist =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $actionlist = $1; }
if (!length($context)) { $context = "%s"; }
if (!length($lifetime)) { $lifetime = 0; }
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|obsolete|unalias)(?:\s+(\S+))?$/i) {
$keyword = lc($1);
$context = defined($2)?$2:"";
process_action_parens($context);
if (!length($context)) { $context = "%s"; }
if ($keyword eq "delete") { return (DELETECONTEXT, $context); }
elsif ($keyword eq "obsolete") { return (OBSOLETECONTEXT, $context); }
else { return (UNALIAS, $context); }
}
elsif ($action =~ /^set\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) {
$context = $1;
$lifetime = $2;
$actionlist = defined($3)?$3:"";
process_action_parens($context, $lifetime);
# strip outer parentheses from actionlist if they exist
if ($actionlist =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $actionlist = $1; }
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for set action");
return INVALIDVALUE;
}
if (!length($lifetime)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty lifetime given for set action");
return INVALIDVALUE;
}
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+))?$/i) {
$context = $1;
$alias = defined($2)?$2:"";
process_action_parens($context, $alias);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for alias action");
return INVALIDVALUE;
}
if (!length($alias)) { $alias = "%s"; }
return (ALIAS, $context, $alias);
}
elsif ($action =~ /^(add|prepend|fill)\s+(\S+)(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$context = $2;
$event = defined($3)?$3:"";
process_action_parens($context, $event);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for $keyword action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
if ($keyword eq "add") { return (ADD, $context, $event); }
elsif ($keyword eq "prepend") { return (PREPEND, $context, $event); }
else { return (FILL, $context, $event); }
}
elsif ($action =~ /^(report|reportexec)\s+(\S+)(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$context = $2;
$cmdline = defined($3)?$3:"";
process_action_parens($context, $cmdline);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for $keyword action");
return INVALIDVALUE;
}
# note that if commandline is not provided, $cmdline is set to
# empty string, and in this case split() produces an empty list
if ($keyword eq "report") { return (REPORT, $context, $cmdline); }
else { return (REPORTEXEC, $context, [ split(' ', $cmdline) ]); }
}
elsif ($action =~ /^(copy|pop|shift)\s+(\S+)\s+(\S+)$/i) {
$keyword = lc($1);
$context = $2;
$variable = $3;
process_action_parens($context);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for $keyword action");
return INVALIDVALUE;
}
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if ($keyword eq "copy") {
return (COPYCONTEXT, $context, substr($variable, 1));
} elsif ($keyword eq "pop") {
return (POP, $context, substr($variable, 1));
} else { return (SHIFT, $context, substr($variable, 1)); }
}
elsif ($action =~ /^empty\s+(\S+)(?:\s+(\S+))?$/i) {
$context = $1;
$variable = defined($2)?$2:"";
process_action_parens($context);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for empty action");
return INVALIDVALUE;
}
if (length($variable) && $variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if (!length($variable)) { return (EMPTYCONTEXT, $context, ""); }
return (EMPTYCONTEXT, $context, substr($variable, 1));
}
elsif ($action =~ /^(exists|getsize|getaliases|getltime|getctime)\s+(\S+)\s+(\S+)$/i) {
$keyword = lc($1);
$variable = $2;
$context = $3;
process_action_parens($context);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for $keyword action");
return INVALIDVALUE;
}
if ($keyword eq "exists") {
return (EXISTS, substr($variable, 1), $context);
} elsif ($keyword eq "getsize") {
return (GETSIZE, substr($variable, 1), $context);
} elsif ($keyword eq "getaliases") {
return (GETALIASES, substr($variable, 1), $context);
} elsif ($keyword eq "getltime") {
return (GETLIFETIME, substr($variable, 1), $context);
} else { return (GETCTIME, substr($variable, 1), $context); }
}
elsif ($action =~ /^setltime\s+(\S+)(?:\s+(\S+))?$/i) {
$context = $1;
$lifetime = defined($2)?$2:"";
process_action_parens($context, $lifetime);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for setltime action");
return INVALIDVALUE;
}
if (!length($lifetime)) { $lifetime = 0; }
return (SETLIFETIME, $context, $lifetime);
}
elsif ($action =~ /^setctime\s+(\S+)\s+(\S+)$/i) {
$timestamp = $1;
$context = $2;
process_action_parens($timestamp, $context);
if (!length($timestamp)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty timestamp given for setctime action");
return INVALIDVALUE;
}
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for setctime action");
return INVALIDVALUE;
}
return (SETCTIME, $timestamp, $context);
}
elsif ($action =~ /^event(?:\s+0*([0-9]+))?(?:\s+(.*\S))?$/i) {
$createafter = defined($1)?$1:"";
$event = defined($2)?$2:"";
process_action_parens($event);
if (!length($createafter)) { $createafter = 0; }
if (!length($event)) { $event = "%s"; }
return (EVENT, $createafter, $event);
}
elsif ($action =~ /^tevent\s+(\S+)(?:\s+(.*\S))?$/i) {
$createafter = $1;
$event = defined($2)?$2:"";
process_action_parens($createafter, $event);
if (!length($createafter)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty time offset given for tevent action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
return (TEVENT, $createafter, $event);
}
elsif ($action =~ /^cevent\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) {
$context = $1;
$createafter = $2;
$event = defined($3)?$3:"";
process_action_parens($context, $createafter, $event);
if (!length($context)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty context name given for cevent action");
return INVALIDVALUE;
}
if (!length($createafter)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty time offset given for cevent action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
return (CEVENT, $context, $createafter, $event);
}
elsif ($action =~ /^reset(?:\s+([+-]?)0*([0-9]+))?(?:\s+(.*\S))?$/i) {
$sign = defined($1)?$1:"";
$rule = defined($2)?$2:"";
$event = defined($3)?$3:"";
process_action_parens($event);
if (length($rule)) {
if ($sign eq "+") { $rule = $ruleid + $rule; }
elsif ($sign eq "-") { $rule = $ruleid - $rule; }
elsif (!$rule) { $rule = $ruleid; }
else { --$rule; }
} else { $rule = ""; }
if (!length($event)) { $event = "%s"; }
return (RESET, $conffile, $rule, $event);
}
elsif ($action =~ /^getwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) {
$variable = $1;
$sign = $2;
$rule = $3;
$event = defined($4)?$4:"";
process_action_parens($event);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if ($sign eq "+") { $rule = $ruleid + $rule; }
elsif ($sign eq "-") { $rule = $ruleid - $rule; }
elsif (!$rule) { $rule = $ruleid; }
else { --$rule; }
if (!length($event)) { $event = "%s"; }
return (GETWINPOS, substr($variable, 1), $conffile, $rule, $event);
}
elsif ($action =~ /^setwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) {
$timestamp = $1;
$sign = $2;
$rule = $3;
$event = defined($4)?$4:"";
process_action_parens($timestamp, $event);
if ($sign eq "+") { $rule = $ruleid + $rule; }
elsif ($sign eq "-") { $rule = $ruleid - $rule; }
elsif (!$rule) { $rule = $ruleid; }
else { --$rule; }
if (!length($timestamp)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty timestamp given for setwpos action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
return (SETWINPOS, $timestamp, $conffile, $rule, $event);
}
elsif ($action =~ /^(assign|assignsq)\s+(\S+)(?:\s+(.*\S))?$/i) {
$keyword = lc($1);
$variable = $2;
$value = defined($3)?$3:"";
process_action_parens($value);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if (!length($value)) { $value = "%s"; }
if ($keyword eq "assign") {
return (ASSIGN, substr($variable, 1), $value);
} else { return (ASSIGNSQ, substr($variable, 1), $value); }
}
elsif ($action =~ /^free\s+(\S+)$/i) {
$variable = $1;
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
return (FREE, substr($variable, 1));
}
elsif ($action =~ /^eval\s+(\S+)\s+(.*\S)$/i) {
$variable = $1;
$code = $2;
process_action_parens($code);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
return (EVAL, substr($variable, 1), $code);
}
elsif ($action =~ /^call\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) {
$variable = $1;
$codeptr = $2;
$params = defined($3)?$3:"";
process_action_parens($params);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
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 !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $codeptr does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
# note that if parameters are not provided, $params is set to
# empty string, and in this case split() produces an empty list
return (CALL, substr($variable, 1),
substr($codeptr, 1), [ split(' ', $params) ]);
}
elsif ($action =~ /^lcall\s+(\S+)\s*(.*?)\s*(->|:>)\s*(.*\S)$/i) {
$variable = $1;
$params = $2;
$op = $3 eq ":>";
$code = $4;
process_action_parens($params, $code);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
($evalok, $codeptr) = SEC::call_eval($code, 0);
if (!$evalok || !defined($codeptr) || ref($codeptr) ne "CODE") {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Eval '$code' didn't return a code reference:",
defined($codeptr)?"$codeptr":"undef");
return INVALIDVALUE;
}
# note that if parameters are not provided, $params is set to
# empty string, and in this case split() produces an empty list
return (LCALL, substr($variable, 1), $codeptr, [ split(' ', $params) ], $op);
}
elsif ($action =~ /^rewrite\s+(\S+)(?:\s+(.*\S))?$/i) {
$count = $1;
$event = defined($2)?$2:"";
process_action_parens($count, $event);
if (!length($count)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty linecount given for rewrite action");
return INVALIDVALUE;
}
if (!length($event)) { $event = "%s"; }
return (REWRITE, $count, $event);
}
elsif ($action =~ /^addinput\s+(\S+)(?:\s+(\S+)(?:\s+(\S+))?)?$/i) {
$file = $1;
$fpos = defined($2)?$2:"";
$context = defined($3)?$3:"";
process_action_parens($file, $fpos, $context);
if (!length($file)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty filename given for addinput action");
return INVALIDVALUE;
}
if (!length($fpos)) { $fpos = "-"; }
if (!length($context)) { $context = FILEVENT_INT_CONTEXT_PREF . $file; }
return (ADDINPUT, $file, $fpos, $context);
}
elsif ($action =~ /^sigemul\s+(\S+)$/i) {
$signal = $1;
process_action_parens($signal);
if (!length($signal)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty signal name given for sigemul action");
return INVALIDVALUE;
}
return (SIGEMUL, $signal);
}
elsif ($action =~ /^varset\s+(\S+)\s+(\S+)$/i) {
$variable = $1;
$entry = $2;
process_action_parens($entry);
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if (!length($entry)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Empty pattern match cache entry name given for varset action");
return INVALIDVALUE;
}
return (VARIABLESET, substr($variable, 1), $entry);
}
elsif ($action =~ /^if\s/i) {
$value = EXPRSYMBOL;
if ($action2 =~ /^if\s+(\S+)\s+$value\s+else\s+$value$/i) {
$variable = $1;
$actionlist = $list->[0];
$actionlist2 = $list->[1];
} elsif ($action2 =~ /^if\s+(\S+)\s+$value$/i) {
$variable = $1;
$actionlist = $list->[0];
$actionlist2 = "";
} else { return INVALIDVALUE; }
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if ($actionlist =~ /^\s*$/) { @action = (); }
elsif (!analyze_actionlist($actionlist, \@action,
$conffile, $lineno, $ruleid)) { return INVALIDVALUE; }
if ($actionlist2 =~ /^\s*$/) { @action2 = (); }
elsif (!analyze_actionlist($actionlist2, \@action2,
$conffile, $lineno, $ruleid)) { return INVALIDVALUE; }
if (!scalar(@action) && !scalar(@action2)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"empty action lists given for if-else");
return INVALIDVALUE;
}
return (IF, substr($variable, 1), [ @action ], [ @action2 ]);
}
elsif ($action =~ /^while\s/i) {
$value = EXPRSYMBOL;
if ($action2 =~ /^while\s+(\S+)\s+$value$/i) {
$variable = $1;
$actionlist = $list->[0];
} else { return INVALIDVALUE; }
if ($variable !~ /^%[[:alpha:]]\w*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Variable $variable does not have the form",
"%<letter>[<letter>|<digit>|<underscore>]...");
return INVALIDVALUE;
}
if ($actionlist =~ /^\s*$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"empty action list given for while");
return INVALIDVALUE;
}
if (!analyze_actionlist($actionlist, \@action,
$conffile, $lineno, $ruleid)) { return INVALIDVALUE; }
return (WHILE, substr($variable, 1), [ @action ]);
}
elsif ($action =~ /^break$/i) { return BREAK; }
elsif ($action =~ /^continue$/i) { return CONTINUE; }
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, $arrayref, $conffile, $lineno, $ruleid) = @_;
my(@parts, $part, $part2);
my($actiontype, @action);
my($newactionlist, @list, @list2, $expr);
my($pos, $l);
@{$arrayref} = ();
# remove leading and trailing whitespace from actionlist
if ($actionlist =~ /^\s*(.*?)\s*$/) { $actionlist = $1; }
# replace the actions that are in parentheses with special symbols
# and save the actions to @list
$newactionlist = replace_subexpr($actionlist, \@list);
if (!defined($newactionlist)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Unbalanced parentheses found in action list '$actionlist'");
return 0;
}
# split actionlist into parts by semicolon, removing
# all whitespace before and after semicolons
@parts = split(/\s*;\s*/, $newactionlist);
$l = length(EXPRSYMBOL);
foreach $part (@parts) {
# substitute special symbols with expressions
# that were removed previously
$part2 = $part;
@list2 = ();
for (;;) {
$pos = index($part, EXPRSYMBOL);
if ($pos == -1) { last; }
$expr = shift @list;
substr($part, $pos, $l) = "(" . $expr . ")";
push @list2, $expr;
}
# analyze the action list part
($actiontype, @action) =
analyze_action($part, $conffile, $lineno, $ruleid, $part2, \@list2);
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 (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, $result) = @_;
my($pos, $oper, $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;
}
# consider '!' operator a negation if it appears in front of the operand
if ($context =~ /^\s*!(.*)/) {
$op1 = $1;
if (!analyze_context_expr($op1, \@side1)) { return 0; }
@{$result} = ( @side1, 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;
$oper = $2;
$op2 = $3;
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;
}
if ($oper eq "->") { @{$result} = ( CCODE, $op1, $op2 ); }
else { @{$result} = ( CCODE2, $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*varset\s+(\S+)\s*$/) {
$op1 = $1;
if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([()])/$1/g; }
@{$result} = ( VARSET, $op1 );
return 1;
}
if ($context =~ /^\s*(\S+)\s*$/) {
$op1 = $1;
if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([()])/$1/g; }
@{$result} = ( OPERAND, $op1 );
return 1;
}
return 0;
}
# Parameters: par1 - context expression
# par2 - reference to an array
# Action: par1 will be analyzed and saved to array par2. 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, $result) = @_;
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 context expression to internal format, and if no parenthesized
# subexpressions were found in the expression during previous step, exit
if (!analyze_context_expr($newcontext, $result)) { return 0; }
if ($newcontext eq $context) { return 1; }
# If the expression contains parenthesized subexpressions, analyze and
# convert these expressions recursively, attaching the results to
# the current expression. If a parenthesized subexpression is a Perl code,
# it will not be analyzed recursively but rather treated as a terminal
# (backslashes in front of the parentheses are removed). If not all
# subexpressions are consumed during the analysis, they have been defined
# in invalid locations (e.g., inside context names).
$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 || $result->[$i] == CCODE2) {
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;
}
elsif ($result->[$i] == VARSET) {
if ($result->[$i+1] eq EXPRSYMBOL) {
$subexpr = shift @expr;
$subexpr =~ s/\\([()])/$1/g;
$result->[$i+1] = $subexpr;
}
$i += 2;
}
else { ++$i; }
}
if (scalar(@expr)) {
foreach $subexpr (@expr) {
log_msg(LOG_ERR, "Unexpected subexpression '$subexpr' in '$context'");
}
return 0;
}
return 1;
}
# Parameters: par1 - context expression
# 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 par5 with
# the key that equals to the calculated value + offset. Leading zeros
# are removed from keys (rest of the code relies on that). E.g., if
# offset is 0, then "02,5-07" 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
# specified incorrectly, return value is 0, otherwise 1 is returned.
sub eval_timelist {
my($spec, $min, $max, $offset, $ref) = @_;
my(@parts, $part, $step);
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; }
# check if part has a valid step value (0 is illegal)
if ($part =~ /^(.+)\/0*([0-9]+)$/) {
$part = $1;
$step = $2;
if ($step == 0) { return 0; }
} else {
$step = undef;
}
# 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; if step was not defined, assume 1
$i = $min + $offset;
$j = $max + $offset;
if (!defined($step)) { $step = 1; }
while ($i <= $j) {
$ref->{$i} = 1;
$i += $step;
}
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 ($part =~ /^0*([0-9]+)$/) { $part = $1; } else { return 0; }
if ($part < $min || $part > $max) { return 0; }
# step value is illegal for a single number
if (defined($step)) { return 0; }
# add offset 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
if (length($range1)) {
if ($range1 =~ /^0*([0-9]+)$/) { $range1 = $1; } else { return 0; }
if ($range1 < $min || $range1 > $max) { return 0; }
$i = $range1 + $offset;
} else { $i = $min + $offset; }
if (length($range2)) {
if ($range2 =~ /^0*([0-9]+)$/) { $range2 = $1; } else { return 0; }
if ($range2 < $min || $range2 > $max) { return 0; }
$j = $range2 + $offset;
} else { $j = $max + $offset; }
# save values to the hash; if step was not defined, assume 1
if (!defined($step)) { $step = 1; }
while ($i <= $j) {
$ref->{$i} = 1;
$i += $step;
}
}
}
return 1;
}
# Parameters: par1 - time specification
# par2..par7 - references to the hashes of minutes, hours,
# days, months, weekdays and years
# par8 - the name of the configuration file
# par9 - 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, $minref, $hourref, $dayref,
$monthref, $wdayref, $yearref, $conffile, $lineno) = @_;
my(@parts, $size);
# split time specification into parts by whitespace (like with
# split(/\s+/, ...)), but leading whitespace will be ignored
@parts = split(' ', $timespec);
$size = scalar(@parts);
if ($size < 5 || $size > 6) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Wrong number of elements in time specification");
return 0;
}
# if no year specification has been given, assume *
if ($size == 5) { push @parts, "*"; }
# 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; }
# evaluate year specification (range 0..99, offset 0)
if (!eval_timelist($parts[5], 0, 99, 0, $yearref)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid year specification '$parts[5]'");
return 0;
}
return 1;
}
# Parameters: par1 - reference to a hash containing the rule
# par2 - hash of required and optional 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
# all keywords are legal (i.e., present in hash par2).
# Return 0 if keywords are OK, otherwise return 1.
sub missing_keywords {
my($ref, $keyhash, $type, $conffile, $lineno) = @_;
my($key, $error);
$error = 0;
# check if all required keywords are present in the rule
while ($key = each %{$keyhash}) {
if ($keyhash->{$key} && !exists($ref->{$key})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Keyword '$key' missing (needed for $type rule)");
$error = 1;
}
}
# check if all rule keywords are legal
while ($key = each %{$ref}) {
if (!exists($keyhash->{$key})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Keyword '$key' illegal (not allowed for $type rule)");
$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 specified rule file options, save the options to
# global array $config_options{par2} if the rule is well-defined.
# For a correctly defined Options-rule return 2, for a correctly
# defined regular rule return 1, for an invalid rule return 0
sub check_rule {
my($ref, $conffile, $lineno, $number) = @_;
my($type, $rule, %keywords);
my($ncomp, $cfset, $evtnum, $i, $j);
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 = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SINGLE,
"VarMap" => {},
"Context" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_SCRIPT rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHSCRIPT") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "script" => 1, "shell" => 0,
"desc" => 1, "action" => 1, "action2" => 0);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SINGLE_W_SCRIPT,
"VarMap" => {},
"Context" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"Action2" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (exists($ref->{"shell"})) {
if (uc($ref->{"shell"}) eq "YES") {
$rule->{"Script"} = $ref->{"script"};
} elsif (uc($ref->{"shell"}) eq "NO") {
$rule->{"Script"} = [ split(' ', $ref->{"script"}) ];
} else {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid shell value '", $ref->{"shell"}, "'");
return 0;
}
} else {
$rule->{"Script"} = $ref->{"script"};
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (exists($ref->{"action2"})) {
if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action2"}, '$'))
{ $rule->{"ActVolat2"} = 1; }
}
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_SUPPRESS rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHSUPPRESS") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
"window" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SINGLE_W_SUPPRESS,
"VarMap" => {},
"Context" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
} else { $rule->{"Window"} = $1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# PAIR rule
# ------------------------------------------------------------
elsif ($type eq "PAIR") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
"continue2" => 0, "ptype2" => 1, "pattern2" => 1,
"varmap2" => 0, "context2" => 0, "desc2" => 1,
"action2" => 1, "window" => 0);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => PAIR,
"VarMap" => {},
"VarMap2" => {},
"Context" => [],
"Context2" => [],
"Desc" => $ref->{"desc"},
"Desc2" => $ref->{"desc2"},
"Action" => [],
"Action2" => [],
"Operations" => {},
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
if (exists($ref->{"continue2"})) {
($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) =
analyze_continue($ref->{"continue2"}, $conffile, $lineno);
if ($rule->{"WhatNext2"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext2"} = DONTCONT;
$rule->{"GotoRule2"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) =
analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
$conffile, $lineno, $rule->{"PatType"});
if ($rule->{"PatType2"} == INVALIDVALUE) { return 0; }
if (defined($ncomp)) { $rule->{"Pat2NotCompiled"} = 1; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"varmap2"})) {
if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"},
$rule->{"VarMap2"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (exists($ref->{"context2"})) {
if (check_context_preeval($ref->{"context2"}))
{ $rule->{"ContPreEval2"} = 1; }
if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context2"}, "'");
return 0;
}
if (volatile_context($rule->{"Context2"}, '$', '%'))
{ $rule->{"ContVolat2"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action2"}, '$', '%'))
{ $rule->{"ActVolat2"} = 1; }
if (!exists($ref->{"window"})) { $rule->{"Window"} = 0; }
elsif ($ref->{"window"} =~ /^0*([0-9]+)$/) { $rule->{"Window"} = $1; }
else {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
}
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# PAIR_W_WINDOW rule
# ------------------------------------------------------------
elsif ($type eq "PAIRWITHWINDOW") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
"continue2" => 0, "ptype2" => 1, "pattern2" => 1,
"varmap2" => 0, "context2" => 0, "desc2" => 1,
"action2" => 1, "window" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => PAIR_W_WINDOW,
"VarMap" => {},
"VarMap2" => {},
"Context" => [],
"Context2" => [],
"Desc" => $ref->{"desc"},
"Desc2" => $ref->{"desc2"},
"Action" => [],
"Action2" => [],
"Operations" => {},
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
if (exists($ref->{"continue2"})) {
($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) =
analyze_continue($ref->{"continue2"}, $conffile, $lineno);
if ($rule->{"WhatNext2"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext2"} = DONTCONT;
$rule->{"GotoRule2"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) =
analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
$conffile, $lineno, $rule->{"PatType"});
if ($rule->{"PatType2"} == INVALIDVALUE) { return 0; }
if (defined($ncomp)) { $rule->{"Pat2NotCompiled"} = 1; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"varmap2"})) {
if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"},
$rule->{"VarMap2"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (exists($ref->{"context2"})) {
if (check_context_preeval($ref->{"context2"}))
{ $rule->{"ContPreEval2"} = 1; }
if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context2"}, "'");
return 0;
}
if (volatile_context($rule->{"Context2"}, '$', '%'))
{ $rule->{"ContVolat2"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action2"}, '$', '%'))
{ $rule->{"ActVolat2"} = 1; }
if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
} else { $rule->{"Window"} = $1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_THRESHOLD rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITHTHRESHOLD") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
"action2" => 0, "window" => 1, "thresh" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SINGLE_W_THRESHOLD,
"VarMap" => {},
"Context" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"Action2" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (exists($ref->{"action2"})) {
if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action2"}, '$'))
{ $rule->{"ActVolat2"} = 1; }
}
if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
} else { $rule->{"Window"} = $1; }
if ($ref->{"thresh"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid threshold '", $ref->{"thresh"}, "'");
return 0;
} else { $rule->{"Threshold"} = $1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# SINGLE_W_2_THRESHOLDS rule
# ------------------------------------------------------------
elsif ($type eq "SINGLEWITH2THRESHOLDS") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
"window" => 1, "thresh" => 1, "desc2" => 1, "action2" => 1,
"window2" => 1, "thresh2" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SINGLE_W_2_THRESHOLDS,
"VarMap" => {},
"Context" => [],
"Desc" => $ref->{"desc"},
"Desc2" => $ref->{"desc2"},
"Action" => [],
"Action2" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action2"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action2"}, '$'))
{ $rule->{"ActVolat2"} = 1; }
if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st time window '", $ref->{"window"}, "'");
return 0;
} else { $rule->{"Window"} = $1; }
if ($ref->{"window2"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd time window '", $ref->{"window2"}, "'");
return 0;
} else { $rule->{"Window2"} = $1; }
if ($ref->{"thresh"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 1st threshold '", $ref->{"thresh"}, "'");
return 0;
} else { $rule->{"Threshold"} = $1; }
if ($ref->{"thresh2"} !~ /^0*([0-9]+)$/) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid 2nd threshold '", $ref->{"thresh2"}, "'");
return 0;
} else { $rule->{"Threshold2"} = $1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# EVENT_GROUP rule
# ------------------------------------------------------------
elsif ($type =~ /^EVENTGROUP(?:0*\B)?([0-9]*)$/) {
$evtnum = length($1)?$1:1;
if ($evtnum < 1) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid rule type $type (N must be at least 1 for EventGroupN rule)");
return 0;
}
%keywords = ("type" => 1, "desc" => 1, "action" => 1, "multact" => 0,
"init" => 0, "slide" => 0, "end" => 0, "window" => 1,
"egptype" => 0, "egpattern" => 0);
for ($i = 0; $i < $evtnum; ++$i) {
$j = ($i==0)?"":($i+1);
$keywords{"continue$j"} = 0;
$keywords{"ptype$j"} = 1;
$keywords{"pattern$j"} = 1;
$keywords{"varmap$j"} = 0;
$keywords{"context$j"} = 0;
$keywords{"count$j"} = 0;
$keywords{"thresh$j"} = 0;
$keywords{"egtoken$j"} = 0;
}
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => EVENT_GROUP,
"EventNumber" => $evtnum,
"WhatNextList" => [],
"GotoRuleList" => [],
"PatTypeList" => [],
"PatternList" => [],
"PatLinesList" => [],
"VarMapList" => [],
"ContextList" => [],
"ContPreEvalList" => {},
"ContVolatList" => {},
"CountActionList" => [],
"CountActVolatList" => {},
"ThresholdList" => [],
"EGrpTokenList" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"InitAction" => [],
"SlideAction" => [],
"EndAction" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
for ($i = 0; $i < $evtnum; ++$i) {
$rule->{"VarMapList"}->[$i] = {};
$rule->{"ContextList"}->[$i] = [];
$rule->{"CountActionList"}->[$i] = [];
$j = ($i==0)?"":($i+1);
if (exists($ref->{"continue$j"})) {
($rule->{"WhatNextList"}->[$i], $rule->{"GotoRuleList"}->[$i]) =
analyze_continue($ref->{"continue$j"}, $conffile, $lineno);
if ($rule->{"WhatNextList"}->[$i] == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNextList"}->[$i] = DONTCONT;
$rule->{"GotoRuleList"}->[$i] = undef;
}
($rule->{"PatTypeList"}->[$i],
$rule->{"PatLinesList"}->[$i],
$rule->{"PatternList"}->[$i]) = analyze_pattern($ref->{"ptype$j"},
$ref->{"pattern$j"},
$conffile, $lineno);
if ($rule->{"PatTypeList"}->[$i] == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap$j"})) {
if (!analyze_varmap($rule->{"PatTypeList"}->[$i],
$ref->{"varmap$j"}, $rule->{"VarMapList"}->[$i],
$conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context$j"})) {
if (check_context_preeval($ref->{"context$j"}))
{ $rule->{"ContPreEvalList"}->{$i} = 1; }
if (!analyze_context($ref->{"context$j"},
$rule->{"ContextList"}->[$i])) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context$j"}, "'");
return 0;
}
if (volatile_context($rule->{"ContextList"}->[$i], '$'))
{ $rule->{"ContVolatList"}->{$i} = 1; }
}
if (exists($ref->{"count$j"})) {
if (!analyze_actionlist($ref->{"count$j"},
$rule->{"CountActionList"}->[$i],
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"count$j"}, "'");
return 0;
}
if (contains_matchvars($ref->{"count$j"}, '$'))
{ $rule->{"CountActVolatList"}->{$i} = 1; }
}
if (exists($ref->{"thresh$j"})) {
if ($ref->{"thresh$j"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid threshold '", $ref->{"thresh$j"}, "'");
return 0;
} else { $rule->{"ThresholdList"}->[$i] = $1; }
} else { $rule->{"ThresholdList"}->[$i] = 1; }
if (exists($ref->{"egtoken$j"}) && !exists($ref->{"egpattern"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"'egtoken$j' keyword requires the 'egpattern' keyword");
return 0;
}
if (exists($ref->{"egpattern"})) {
if (exists($ref->{"egtoken$j"})) {
$rule->{"EGrpTokenList"}->[$i] = $ref->{"egtoken$j"};
} else {
$rule->{"EGrpTokenList"}->[$i] = $i + 1;
}
}
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
if (contains_matchvars($ref->{"action"}, '$'))
{ $rule->{"ActVolat"} = 1; }
if (exists($ref->{"init"})) {
if (!analyze_actionlist($ref->{"init"}, $rule->{"InitAction"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"init"}, "'");
return 0;
}
if (contains_matchvars($ref->{"init"}, '$'))
{ $rule->{"InitActVolat"} = 1; }
}
if (exists($ref->{"slide"})) {
if (!analyze_actionlist($ref->{"slide"}, $rule->{"SlideAction"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"slide"}, "'");
return 0;
}
if (contains_matchvars($ref->{"slide"}, '$'))
{ $rule->{"SlideActVolat"} = 1; }
}
if (exists($ref->{"end"})) {
if (!analyze_actionlist($ref->{"end"}, $rule->{"EndAction"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"end"}, "'");
return 0;
}
if (contains_matchvars($ref->{"end"}, '$'))
{ $rule->{"EndActVolat"} = 1; }
}
if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid time window '", $ref->{"window"}, "'");
return 0;
} else { $rule->{"Window"} = $1; }
if (exists($ref->{"multact"})) {
if (uc($ref->{"multact"}) eq "YES") { $rule->{"MultipleActions"} = 1; }
elsif (uc($ref->{"multact"}) ne "NO") {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid multact value '", $ref->{"multact"}, "'");
return 0;
}
}
if (exists($ref->{"egptype"}) && !exists($ref->{"egpattern"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"'egptype' keyword requires the 'egpattern' keyword");
return 0;
}
if (exists($ref->{"egpattern"}) && !exists($ref->{"egptype"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"'egpattern' keyword requires the 'egptype' keyword");
return 0;
}
if (exists($ref->{"egpattern"})) {
($rule->{"EGrpPatType"}, $rule->{"EGrpPattern"}) =
analyze_eventgroup_pattern($ref->{"egptype"}, $ref->{"egpattern"},
$conffile, $lineno);
if ($rule->{"EGrpPatType"} == INVALIDVALUE) { return 0; }
}
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# SUPPRESS rule
# ------------------------------------------------------------
elsif ($type eq "SUPPRESS") {
%keywords = ("type" => 1, "ptype" => 1, "pattern" => 1,
"varmap" => 0, "context" => 0, "desc" => 0);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => SUPPRESS,
"VarMap" => {},
"Context" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!exists($ref->{"desc"})) {
if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR ||
$rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) {
$rule->{"Desc"} =
"Suppress rule with pattern: " . $rule->{"Pattern"};
} elsif ($rule->{"PatType"} == NREGEXP ||
$rule->{"PatType"} == NSUBSTR ||
$rule->{"PatType"} == NPERLFUNC ||
$rule->{"PatType"} == NCACHED) {
$rule->{"Desc"} =
"Suppress rule with negative pattern: " . $rule->{"Pattern"};
} else {
$rule->{"Desc"} =
"Suppress rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE");
}
} else { $rule->{"Desc"} = $ref->{"desc"}; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# CALENDAR rule
# ------------------------------------------------------------
elsif ($type eq "CALENDAR") {
%keywords = ("type" => 1, "time" => 1, "context" => 0,
"desc" => 1, "action" => 1);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => CALENDAR,
"Minutes" => {},
"Hours" => {},
"Days" => {},
"Months" => {},
"Weekdays" => {},
"Years" => {},
"LastActionMinute" => 0,
"LastActionHour" => 0,
"LastActionDay" => 0,
"LastActionMonth" => 0,
"LastActionYear" => 0,
"Context" => [],
"Desc" => $ref->{"desc"},
"Action" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (!analyze_timespec($ref->{"time"},
$rule->{"Minutes"}, $rule->{"Hours"},
$rule->{"Days"}, $rule->{"Months"},
$rule->{"Weekdays"}, $rule->{"Years"},
$conffile, $lineno)) { return 0; }
# since for Calendar rule []-operator has no meaning, remove outer
# square brackets if they exist, and don't set the ContPreEval flag
if (exists($ref->{"context"})) {
check_context_preeval($ref->{"context"});
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
}
if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
$conffile, $lineno, $number)) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid action list '", $ref->{"action"}, "'");
return 0;
}
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# JUMP rule
# ------------------------------------------------------------
elsif ($type eq "JUMP") {
%keywords = ("type" => 1, "continue" => 0, "ptype" => 1,
"pattern" => 1, "varmap" => 0, "context" => 0,
"cfset" => 0, "constset" => 0, "desc" => 0);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
$rule = { "ID" => $number,
"Type" => JUMP,
"VarMap" => {},
"Context" => [],
"MatchCount" => 0,
"EventCount" => 0,
"CPUtime" => 0,
"LineNo" => $lineno };
if (exists($ref->{"continue"})) {
($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
analyze_continue($ref->{"continue"}, $conffile, $lineno);
if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; }
} else {
$rule->{"WhatNext"} = DONTCONT;
$rule->{"GotoRule"} = undef;
}
($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
if ($rule->{"PatType"} == INVALIDVALUE) { return 0; }
if (exists($ref->{"varmap"})) {
if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
$rule->{"VarMap"}, $conffile, $lineno)) { return 0; }
}
if (exists($ref->{"context"})) {
if (check_context_preeval($ref->{"context"}))
{ $rule->{"ContPreEval"} = 1; }
if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid context expression '", $ref->{"context"}, "'");
return 0;
}
if (volatile_context($rule->{"Context"}, '$'))
{ $rule->{"ContVolat"} = 1; }
}
if (!exists($ref->{"desc"})) {
if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR ||
$rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) {
$rule->{"Desc"} =
"Jump rule with pattern: " . $rule->{"Pattern"};
} elsif ($rule->{"PatType"} == NREGEXP ||
$rule->{"PatType"} == NSUBSTR ||
$rule->{"PatType"} == NPERLFUNC ||
$rule->{"PatType"} == NCACHED) {
$rule->{"Desc"} =
"Jump rule with negative pattern: " . $rule->{"Pattern"};
} else {
$rule->{"Desc"} =
"Jump rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE");
}
} else { $rule->{"Desc"} = $ref->{"desc"}; }
if (exists($ref->{"cfset"})) {
$rule->{"CFSet"} = [ split(' ', $ref->{"cfset"}) ];
}
if (exists($ref->{"constset"})) {
if (uc($ref->{"constset"}) eq "YES") { $rule->{"ConstSet"} = 1; }
elsif (uc($ref->{"constset"}) ne "NO") {
log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
"Invalid constset value '", $ref->{"constset"}, "'");
return 0;
}
} else { $rule->{"ConstSet"} = 1; }
$configuration{$conffile}->[$number] = $rule;
return 1;
}
# ------------------------------------------------------------
# OPTIONS rule
# ------------------------------------------------------------
elsif ($type eq "OPTIONS") {
%keywords = ("type" => 1, "joincfset" => 0, "procallin" => 0);
if (missing_keywords($ref, \%keywords, $type,
$conffile, $lineno)) { return 0; }
# discard any previous Options rule
$config_options{$conffile} = {};
# parse and save the procallin value; assume default for invalid value
if (exists($ref->{"procallin"})) {
if (uc($ref->{"procallin"}) eq "NO") {
$config_options{$conffile}->{"JumpOnly"} = 1;
} elsif (uc($ref->{"procallin"}) ne "YES") {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"Invalid procallin value '", $ref->{"procallin"},
"', assuming procallin=Yes");
}
}
# parse and save the list of set names
if (exists($ref->{"joincfset"})) {
$config_options{$conffile}->{"CFSet"} = {};
foreach $cfset (split(' ', $ref->{"joincfset"})) {
$config_options{$conffile}->{"CFSet"}->{$cfset} = 1;
}
}
return 2;
}
# ------------------------------------------------------------
# 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
# par2 - reference to the hash of label->rule conversion
# Action: process continue-statements of rules of configuration file par1,
# and resolve labels in 'continue=GoTo <label>' directives to rule
# numbers. The numbers are stored into memory-based representation
# of rules. Note that 'continue=TakeNext' is treated as
# 'continue=GoTo <nextrule>' (i.e., the number of the next rule is
# stored). Also note that 'continue=DontCont' is treated as
# 'continue=GoTo <lastrule+1>', and 'continue=EndMatch' as
# 'continue=GoTo -1'. Although Suppress rule doesn't support
# continue-statement, internally 'continue=GoTo <lastrule+1>' is used
# for simplifying the rule processing at run time.
sub resolve_labels {
my($conffile, $label2rule) = @_;
my($i, $j, $k, $n);
my($ref, $label, $id, $lineno);
$n = scalar(@{$configuration{$conffile}});
for ($i = 0; $i < $n; ++$i) {
$ref = $configuration{$conffile}->[$i];
if ($ref->{"Type"} == SUPPRESS) { $ref->{"GotoRule"} = $n; }
elsif (exists($ref->{"WhatNextList"})) {
for ($j = 0; $j < $ref->{"EventNumber"}; ++$j) {
if ($ref->{"WhatNextList"}->[$j] == GOTO) {
$label = $ref->{"GotoRuleList"}->[$j];
$lineno = $ref->{"LineNo"};
$k = ($j==0)?"":($j+1);
if (exists($label2rule->{$label})) {
$id = $label2rule->{$label};
if ($id <= $i) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"can't go backwards to label $label, assuming continue$k=DontCont");
$ref->{"WhatNextList"}->[$j] = DONTCONT;
$ref->{"GotoRuleList"}->[$j] = $n;
} else { $ref->{"GotoRuleList"}->[$j] = $id; }
} else {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"label $label does not exist, assuming continue$k=DontCont");
$ref->{"WhatNextList"}->[$j] = DONTCONT;
$ref->{"GotoRuleList"}->[$j] = $n;
}
} elsif ($ref->{"WhatNextList"}->[$j] == TAKENEXT) {
$ref->{"GotoRuleList"}->[$j] = $i + 1;
} elsif ($ref->{"WhatNextList"}->[$j] == DONTCONT) {
$ref->{"GotoRuleList"}->[$j] = $n;
} elsif ($ref->{"WhatNextList"}->[$j] == ENDMATCH) {
$ref->{"GotoRuleList"}->[$j] = -1;
}
}
}
else {
if (exists($ref->{"WhatNext"})) {
if ($ref->{"WhatNext"} == GOTO) {
$label = $ref->{"GotoRule"};
$lineno = $ref->{"LineNo"};
if (exists($label2rule->{$label})) {
$id = $label2rule->{$label};
if ($id <= $i) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"can't go backwards to label $label, assuming continue=DontCont");
$ref->{"WhatNext"} = DONTCONT;
$ref->{"GotoRule"} = $n;
} else { $ref->{"GotoRule"} = $id; }
} else {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"label $label does not exist, assuming continue=DontCont");
$ref->{"WhatNext"} = DONTCONT;
$ref->{"GotoRule"} = $n;
}
} elsif ($ref->{"WhatNext"} == TAKENEXT) {
$ref->{"GotoRule"} = $i + 1;
} elsif ($ref->{"WhatNext"} == DONTCONT) {
$ref->{"GotoRule"} = $n;
} elsif ($ref->{"WhatNext"} == ENDMATCH) {
$ref->{"GotoRule"} = -1;
}
}
if (exists($ref->{"WhatNext2"})) {
if ($ref->{"WhatNext2"} == GOTO) {
$label = $ref->{"GotoRule2"};
$lineno = $ref->{"LineNo"};
if (exists($label2rule->{$label})) {
$id = $label2rule->{$label};
if ($id <= $i) {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"can't go backwards to label $label, assuming continue2=DontCont");
$ref->{"WhatNext2"} = DONTCONT;
$ref->{"GotoRule2"} = $n;
} else { $ref->{"GotoRule2"} = $id; }
} else {
log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
"label $label does not exist, assuming continue2=DontCont");
$ref->{"WhatNext2"} = DONTCONT;
$ref->{"GotoRule2"} = $n;
}
} elsif ($ref->{"WhatNext2"} == TAKENEXT) {
$ref->{"GotoRule2"} = $i + 1;
} elsif ($ref->{"WhatNext2"} == DONTCONT) {
$ref->{"GotoRule2"} = $n;
} elsif ($ref->{"WhatNext2"} == ENDMATCH) {
$ref->{"GotoRule2"} = -1;
}
}
}
}
}
# Parameters: par1 - name of the configuration file
# Action: read in rules from configuration file par1, so that leading
# and trailing whitespace is removed both from keywords and values
# of rule definions, and then call check_rule() for every rule.
# if all rules in the file are correctly defined, return 1,
# otherwise return 0
sub read_configfile {
my($conffile) = $_[0];
my($fh, $linebuf, $line, $i, $cont, $rulestart);
my($keyword, $value, $ret, $file_status);
my(%rule, %label2rule);
$file_status = 1; # start with the assumption that all rules
# are correctly defined
log_msg(LOG_NOTICE, "Reading configuration from $conffile");
if (!open($fh, $conffile)) {
log_msg(LOG_ERR, "Can't open configuration file $conffile ($!)");
return 0;
}
$i = 0;
$cont = 0;
%rule = ();
$rulestart = 1;
%label2rule = ();
for (;;) {
# read next line from file
$linebuf = <$fh>;
# 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)) {
$ret = check_rule(\%rule, $conffile, $rulestart, $i);
if ($ret == 1) { ++$i; }
elsif ($ret == 0) { $file_status = 0; }
%rule = ();
}
$rulestart = $. + 1;
if (defined($linebuf)) { next; } else { last; }
}
# split line into keyword and value
if ($line =~ /^\s*([[:alnum:]]+)\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;
}
# if the keyword is "label", save the number of currently unfinished
# or upcoming rule definition to the hash %label2rule;
# if the keyword is "rem", ignore it as a comment;
# otherwise save the keyword and value to the hash %rule
if ($keyword eq "label") { $label2rule{$value} = $i; }
elsif ($keyword ne "rem") {
if (exists($rule{$keyword})) {
log_msg(LOG_WARN, "Several '$keyword' keywords specified,",
"overriding previous value '$rule{$keyword}' with '$value'");
}
$rule{$keyword} = $value;
}
}
# if valid rules were loaded, resolve 'continue=GoTo' labels
if ($i) {
resolve_labels($conffile, \%label2rule);
log_msg(LOG_DEBUG, "$i rules loaded from $conffile");
} else {
log_msg(LOG_WARN, "No valid rules found in configuration file $conffile");
}
close($fh);
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;
# also, create other global arrays for managing configuration
sub read_config {
my($pattern, $conffile, $ret, $cfset);
my(@stat, @rules, @files, %uniq);
# Set the $lastconfigload variable to reflect the current time
$lastconfigload = time();
# Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
# %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles.
# The @conffiles array holds the names of _all_ configuration files;
# the members of @conffiles act as keys for the %configuration,
# %config_ltimes, %config_mtimes and %config_options global hashes.
# The %cfset2cfile hash creates a mapping between config fileset names
# and file names - for each set name there is a file name list.
# The files with rules accepting all input are stored to @mainfiles.
%configuration = ();
%config_ltimes = ();
%config_mtimes = ();
%config_options = ();
@calendar = ();
@conffiles = ();
%cfset2cfile = ();
@maincfiles = ();
# Form the list of configuration files and save it to @conffiles;
# repeated occurrences of the same file are discarded from the list
@files = ();
foreach $pattern (@conffilepat) { push @files, glob($pattern); }
%uniq = ();
@conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files);
# Read the configuration from rule files and store it to the global
# array %configuration; also, store mtimes and options of rule files to
# the global arrays %config_mtimes and %config_options; save Calendar
# rules to the global array Calendar and set the %cfset2cfile hash
$ret = 1;
foreach $conffile (@conffiles) {
$configuration{$conffile} = [];
$config_ltimes{$conffile} = $lastconfigload;
@stat = stat($conffile);
$config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0;
$config_options{$conffile} = {};
if (!read_configfile($conffile)) { $ret = 0; }
@rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
push @calendar, @rules;
if (exists($config_options{$conffile}->{"CFSet"})) {
while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) {
if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; }
push @{$cfset2cfile{$cfset}}, $conffile;
}
}
}
# Create the @maincfiles array - it holds the names of configuration
# files that accept input from all sources, not from Jump rules only
@maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles);
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, create other global arrays for managing configuration.
# As its output, the function stores 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, $cfset);
my(%old_config, %old_ltimes, %old_mtimes, %old_options);
my(@old_conffiles, @stat, @rules, @files, %uniq);
# Back up global arrays %configuration, %config_ltimes, %config_mtimes,
# and @conffiles
%old_config = %configuration;
%old_ltimes = %config_ltimes;
%old_mtimes = %config_mtimes;
%old_options = %config_options;
@old_conffiles = @conffiles;
# Set the $lastconfigload variable to reflect the current time
$lastconfigload = time();
# Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
# %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles.
# The @conffiles array holds the names of _all_ configuration files;
# the members of @conffiles act as keys for the %configuration,
# %config_ltimes, %config_mtimes and %config_options global hashes.
# The %cfset2cfile hash creates a mapping between config fileset names
# and file names - for each set name there is a file name list.
# The files with rules accepting all input are stored to @mainfiles.
%configuration = ();
%config_ltimes = ();
%config_mtimes = ();
%config_options = ();
@calendar = ();
@conffiles = ();
%cfset2cfile = ();
@maincfiles = ();
# Form the list of configuration files and save it to @conffiles;
# repeated occurrences of the same file are discarded from the list
@files = ();
foreach $pattern (@conffilepat) { push @files, glob($pattern); }
%uniq = ();
@conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files);
# Read the configuration from rule files that are new or have been
# modified and store it to the global array %configuration; store mtimes
# and options of rule files to the global arrays %config_mtimes and
# %config_options; save Calendar rules to the global array Calendar and
# set the %cfset2cfile hash.
# 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} = [];
$config_options{$conffile} = {};
read_configfile($conffile);
$config_ltimes{$conffile} = $lastconfigload;
} elsif ($old_mtimes{$conffile} != $config_mtimes{$conffile}) {
$configuration{$conffile} = [];
$config_options{$conffile} = {};
read_configfile($conffile);
$config_ltimes{$conffile} = $lastconfigload;
push @{$file_list}, $conffile;
} else {
$configuration{$conffile} = $old_config{$conffile};
$config_options{$conffile} = $old_options{$conffile};
$config_ltimes{$conffile} = $old_ltimes{$conffile};
}
@rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
push @calendar, @rules;
if (exists($config_options{$conffile}->{"CFSet"})) {
while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) {
if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; }
push @{$cfset2cfile{$cfset}}, $conffile;
}
}
}
# Create the @maincfiles array - it holds the names of configuration
# files that accept input from all sources, not from Jump rules only
@maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles);
# 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: -
# Action: set special action list variables for special characters
sub set_actionlist_char_var {
my($i);
# setting %% variable to % ensures that all occurrences of %% are
# substituted with %
$variables{"%"} = "%";
# set other action list variables for various special characters
$variables{".nl"} = "\n";
$variables{".cr"} = "\r";
$variables{".tab"} = "\t";
$variables{".sp"} = " ";
for ($i = 0; $i < 256; ++$i) { $variables{".chr$i"} = chr($i); }
}
# Parameters: par1 - timestamp (seconds since Epoch)
# Action: set special action list variables for timestamp par1
sub set_actionlist_time_var {
my(@ltime) = localtime($_[0]);
$variables{".sec"} = ($ltime[0] < 10)?("0" . $ltime[0]):$ltime[0];
$variables{".min"} = ($ltime[1] < 10)?("0" . $ltime[1]):$ltime[1];
$variables{".hour"} = ($ltime[2] < 10)?("0" . $ltime[2]):$ltime[2];
$variables{".hmsstr"} = $variables{".hour"} . ":" . $variables{".min"}
. ":" . $variables{".sec"};
if ($ltime[3] < 10) {
$variables{".mday"} = "0" . $ltime[3];
$variables{".mdaystr"} = " " . $ltime[3];
} else {
$variables{".mday"} = $ltime[3];
$variables{".mdaystr"} = $ltime[3];
}
$variables{".mon"} = ($ltime[4] < 9)?("0" . ($ltime[4]+1)):$ltime[4]+1;
$variables{".monstr"} = POSIX::strftime("%b", @ltime);
$variables{".year"} = $ltime[5] + 1900;
$variables{".wday"} = $ltime[6];
$variables{".wdaystr"} = POSIX::strftime("%a", @ltime);
$variables{".tzname"} = POSIX::strftime("%Z", @ltime);
$variables{".tzoff"} = POSIX::strftime("%z", @ltime);
if ($variables{".tzoff"} =~ /^([+-][0-9]{2})([0-9]{2})$/) {
$variables{".tzoff2"} = "$1:$2";
} else {
$variables{".tzoff2"} = "";
}
}
# Parameters: par1 - string
# par2 - string
# Action: all action list variables in string par1 will be replaced with
# their values; string par2 will be assigned to special variable %s
sub substitute_actionlist_var {
if (index($_[0], "%") == -1) { return; }
my($time) = time();
# if builtin time-based action list variables do not reflect the current
# second, set these variables to proper values
if ($time != $timevar_update) {
set_actionlist_time_var($time);
$timevar_update = $time;
}
# since %u and %t variables can be modified from actions (e.g., 'assign'),
# they are set to proper values before each substitution
$variables{"u"} = $time;
$variables{"t"} = localtime($time);
# set %s variable to operation description string (second parameter)
$variables{"s"} = $_[1];
# substitute all action list variables
$_[0] =~ s/%(?:(\.?[[:alpha:]]\w*|%)|\{(\.?[[:alpha:]]\w*)\})/
defined($variables{$+})?$variables{$+}:""/egx;
}
# Parameters: par1 - commandline
# par2 - 'collect output' flag
# par3 - context
# Action: commandline par1 is executed with perl exec() in a child process.
# If par1 is a reference to an array, commandline in array is
# executed without shell interpretation; otherwise commandline is
# interpreted with shell if it contains shell metacharacters.
# The function creates an entry in the %children hash for the child
# process and returns its pid. If process creation failed, undef is
# returned. If par2 is defined and non-zero, standard output of the
# commandline is returned to the main process through a pipe. If par3
# is also defined, commandline's standard output is returned with an
# internal context par3 (otherwise default internal context is used).
sub exec_cmd {
my($cmdline, $collect_output, $context) = @_;
my($cmd, $shell, $pid, $read, $write);
# if the commandline has been provided as a reference to an array,
# configure its execution without shell interpretation; also, set
# $cmd variable to the entire commandline string
if (ref($cmdline) eq "ARRAY") {
$cmd = join(" ", @{$cmdline});
$shell = 0;
} else {
$cmd = $cmdline;
$shell = 1;
}
# set up a pipe before calling fork()
if ($collect_output && !pipe($read, $write)) {
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);
close($write);
}
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);
$children{$pid}->{"fh"} = $read;
$children{$pid}->{"open"} = 1;
$children{$pid}->{"context"} =
defined($context)?$context:SYNEVENT_INT_CONTEXT;
}
log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'");
return $pid;
}
# we are in the child process now...
if ($collect_output) {
# close the read end of the pipe and connect the standard output of
# the child process to the write end of the pipe
close($read);
if (!open(STDOUT, ">&", $write)) { exit(1); }
close($write);
}
# set SIGPIPE handling back to default before calling exec() (SIGPIPE is
# ignored and exec() will only reset custom signal handlers to default)
$SIG{PIPE} = 'DEFAULT';
# set SIGTERM handling back to default (terminate) before calling exec();
# if this process has received SIGTERM before default handling became
# active, terminate the process without calling exec()
$SIG{TERM} = 'DEFAULT';
if (exists($terminate{$$})) { exit(0); }
# execute commandline - by default exec() keeps file descriptors 0..2 open
# and closes other descriptors (see $^F special variable in perl docs);
# if commandline must be executed without shell interpretation, call
# exec() with list of commandline arguments and provide the first element
# of the list as indirect object { $cmdline->[0] } (that disables shell
# interpretation even if list has one element)
if ($shell) {
exec($cmdline);
} else {
exec { $cmdline->[0] } @{$cmdline};
}
exit(1);
}
# Parameters: par1 - commandline
# par2 - reference to a hash or an array
# Action: this function creates two processes for executing commandline par1.
# The child process writes the contents of array par2 (or keys of hash
# par2) to the standard input of the commandline through a pipe.
# Writing is synchronous (blocking) and hence the need for a separate
# process. The grandchild has its standard input connected to the read
# end of the pipe and executes the commandline with perl exec().
# If par1 is a reference to an array, commandline in array is
# executed without shell interpretation; otherwise commandline is
# interpreted with shell if it contains shell metacharacters.
# The function creates an entry in the %children hash for the child
# process and returns its pid. If child process creation failed, undef
# is returned. After the commandline has completed, the child process
# terminates and returns grandchild exit code for its own exit value.
sub pipe_cmd {
my($cmdline, $ref) = @_;
my($cmd, $shell, $pid, $read, $write, $elem, $p);
# if the commandline has been provided as a reference to an array,
# configure its execution without shell interpretation; also, set
# $cmd variable to the entire commandline string
if (ref($cmdline) eq "ARRAY") {
$cmd = join(" ", @{$cmdline});
$shell = 0;
} else {
$cmd = $cmdline;
$shell = 1;
}
# 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...
# create a pipe for communicating with the commandline
if (!pipe($read, $write)) { exit(1); }
# Fork a process for commandline with pipe connected to its standard input.
# open(pipe, "| cmd") with blocking close(pipe) that returns child exit code
# are not used - if SIGTERM interrupts blocking close(pipe) and triggers
# exit(0) from its handler, many perl versions produce the warning "refcnt:
# fd -1 < 0", because exit() attempts to close the pipe for the second time.
$pid = fork();
if (!defined($pid)) { exit(1); }
if (!$pid) {
# we are in the grandchild process now... close the write end of
# the pipe and connect the standard input to the read end of the pipe
close($write);
if (!open(STDIN, "<&", $read)) { exit(1); }
close($read);
# set SIGPIPE handling back to default before calling exec() (SIGPIPE is
# ignored and exec() will only reset custom signal handlers to default)
$SIG{PIPE} = 'DEFAULT';
# set SIGTERM handling back to default (terminate) before calling exec();
# if this process has received SIGTERM before default handling became
# active, terminate the process without calling exec()
$SIG{TERM} = 'DEFAULT';
if (exists($terminate{$$})) { exit(0); }
# execute commandline - by default exec() keeps file descriptors 0..2 open
# and closes other descriptors (see $^F special variable in perl docs);
# if commandline must be executed without shell interpretation, call
# exec() with list of commandline arguments and provide the first element
# of the list as indirect object { $cmdline->[0] } (that disables shell
# interpretation even if list has one element)
if ($shell) {
exec($cmdline);
} else {
exec { $cmdline->[0] } @{$cmdline};
}
exit(1);
}
# we are in the child process now (grandchild is our child)...
# close the read end of the pipe and make the write end unbuffered
close($read);
select($write);
$| = 1;
# Set a new signal handler for SIGTERM that forwards it to child process
# and exits. Since the handler could be triggered after blocking waitpid()
# has returned and reaped the child from process table, the presence of
# child is verified with nonblocking waitpid() before forwarding SIGTERM.
# If the current process has received SIGTERM before the new handler became
# active, forward SIGTERM to child process and exit (child must exist since
# waitpid() has not been called yet for child).
$SIG{TERM} = sub { my($ret) = waitpid($pid, WNOHANG);
if ($ret == -1) { exit(0); }
if ($ret != 0 && ($WIN32 || WIFEXITED($?) ||
WIFSIGNALED($?))) { exit(0); }
kill('TERM', $pid);
exit(0); };
if (exists($terminate{$$})) {
kill('TERM', $pid);
exit(0);
}
# since this process does not call exec() which closes all file descriptors
# apart from 0..2 (see $^F special variable in perl docs), close all inputs,
# outputs, the logfile, and connection to the system logger (if this is not
# done, removed input/output files and connections established over sockets
# would be kept open even after the parent process has closed them)
%inputsrc = ();
close_outputs();
if ($logopen) { close($loghandle); }
if ($syslogopen) { eval { Sys::Syslog::closelog() }; }
# write data to pipe in blocking mode (ignoring SIGPIPE is inherited from
# the main SEC process and writing to pipe is thus safe)
if (ref($ref) eq "HASH") {
while ($elem = each(%{$ref})) { print $write $elem, "\n"; }
} else {
foreach $elem (@{$ref}) { print $write $elem, "\n"; }
}
# close the pipe immediately after writing (many commands don't terminate
# without seeing EOF in stdin and without close() there would be deadlock)
close($write);
for (;;) {
# wait for child process in blocking mode; waitpid() returns the pid
# of the exited child process, return value -1 means there is no child
# process with the given pid, while 0 means the child is still running
$p = waitpid($pid, 0);
# call exit(1) if according to waitpid() the child does not exist (i.e.,
# its exit code has already been collected which should never happen)
if ($p == -1) { exit(1); }
# if the child has exited, return its exit code with exit()
if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) {
exit($? >> 8);
}
}
}
# Parameters: par1 - host
# par2 - port
# par3 - protocol
# Action: Create the socket and address information data structure for
# communicating with remote peer at host par1 and port par2 over
# protocol par3. On success, return socket filehandle and address
# information data structure, otherwise return undef.
sub create_sock_addr {
my($host, $port, $proto) = @_;
my($handle, $socktype, $iaddr, $paddr, $errlogged);
my($err, $addrinfo, @addrinfo, %hints);
# set the socket type according to protocol
if ($proto eq "tcp") { $socktype = SOCK_STREAM; }
elsif ($proto eq "udp") { $socktype = SOCK_DGRAM; }
else {
log_msg(LOG_ERR, "Creating sockets for protocol $proto is not supported");
return undef;
}
# if perl Socket module has getaddrinfo() function which supports both
# ipv4 and ipv6, use it for creating the socket; if we are dealing with
# older perl version where Socket module comes without getaddrinfo(), use
# traditional ipv4-only inet_aton() based approach for creating the socket
if (defined(&Socket::getaddrinfo)) {
# set up the hints data structure for getaddrinfo() -- note that
# if socket type is not provided as a hint, getaddrinfo() returns
# an error on some platforms if service port specification is not
# textual but numeric
$hints{"socktype"} = $socktype;
$hints{"protocol"} = getprotobyname($proto);
($err, @addrinfo) = Socket::getaddrinfo($host, $port, \%hints);
if ($err) {
log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto ($err)");
return undef;
}
# go through addrinfo list and try to create sockets for list elements,
# returning the first successfully created socket (an attempt for first
# list element might not always succeed, e.g., consider a scenario
# where the first element represents an ipv6 address and the second
# element ipv4 address, while the local host only supports ipv4)
$paddr = undef;
$errlogged = 0;
foreach $addrinfo (@addrinfo) {
if (!socket($handle, $addrinfo->{"family"},
$addrinfo->{"socktype"},
$addrinfo->{"protocol"})) {
$errlogged = 1;
log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)");
next;
}
$paddr = $addrinfo->{"addr"};
last;
}
# if the creation of the socket failed in the above loop, return undef
if (!defined($paddr)) { return undef; }
# if socket was successfully created in the above loop, but one (or more)
# loop iteration(s) failed and produced error message(s), log a message
# about successful creation of the socket
if ($errlogged) {
log_msg(LOG_DEBUG, "Socket for $host:$port/$proto successfully created");
}
} else {
$iaddr = inet_aton($host);
if (!defined($iaddr)) {
log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto",
"(unable to convert $host to Internet address)");
return undef;
}
$paddr = sockaddr_in($port, $iaddr);
if (!socket($handle, PF_INET, $socktype, getprotobyname($proto))) {
log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)");
return undef;
}
}
return ($handle, $paddr);
}
# Parameters: par1 - handle of the socket
# par2 - event
# par3 - name of the destination
# Action: Send event par2 to socket par1 with the send(2) system call, and
# produce a log message in the case of an error. In the log message,
# par3 reflects the destination, and the message is logged with debug
# level, in order to prevent message floods with higher severity when
# large amounts of data are transfered. Return 0 if send(2) failed,
# so that the socket should be closed; return 1 if event was partially
# transmitted or could not be transmitted due to perl wide characters
# or insufficient buffer space; return 2 on successful transmission.
sub send_to_socket {
my($socket, $event, $dest) = @_;
my($nbytes);
for (;;) {
# if the event contains perl wide characters, send() will die,
# thus eval is used for calling it; according to posix, EWOULDBLOCK
# or EAGAIN indicates that the socket buffer is full, while EMSGSIZE
# means that the message is too large for the given socket type
$nbytes = eval { send($socket, $event, 0) };
if ($@) {
log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($@)");
return 1;
} elsif (!defined($nbytes)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($!)");
if ($! == EWOULDBLOCK || $! == EAGAIN || $! == EMSGSIZE) { return 1; }
return 0;
} elsif ($nbytes != length($event)) {
log_msg(LOG_DEBUG, "$nbytes bytes of '$event' sent to $dest");
return 1;
} else {
return 2;
}
}
}
# Parameters: par1 - handle of the socket
# par2 - operation type (0 denotes reading and 1 writing)
# Action: Check if socket par1 is ready for operation par2 (i.e., whether
# the socket is ready for reading or writing); return 1 if socket
# par1 is ready for operation par2, otherwise return 0
sub socket_ready {
my($socket, $operation) = @_;
my($bitmask, $ret);
for (;;) {
# create the bitmask for socket handle
$bitmask = '';
vec($bitmask, fileno($socket), 1) = 1;
# poll the socket with select() if it is ready for reading or writing
if ($operation) { $ret = select(undef, $bitmask, undef, 0); }
else { $ret = select($bitmask, undef, undef, 0); }
# if select() fails with EINTR, try again, otherwise quit the polling
if ((!defined($ret) || $ret < 0) && $! == EINTR) { next; } else { last; }
}
# if the socket is ready, return 1, otherwise return 0
if (defined($ret) && $ret > 0) { return 1; } else { return 0; }
}
# Parameters: par1 - reference to the socket hash table for new connections
# par2 - reference to the socket hash table for connections with
# completed establishment
# par3 - peer ID that identifies socket in tables par1 and par2
# par4 - textual peer type
# Action: Check the status of a connection which is not yet established and
# corresponds to socket par3 in table par1. If the establishment of
# the connection is complete, move the socket par3 from table par1
# to table par2. Textual peer type par4 and peer ID par3 are used
# in error log messages, and messages are logged with debug level,
# in order to prevent message floods with higher severity when large
# amounts of data are transfered.
sub check_new_conn {
my($new_sockets, $est_sockets, $peer, $peertype) = @_;
my($event);
# Check if socket is writable (indicates that connection establishment
# has completed either successfully or with error).
# If the establishment is still incomplete and the establishment timeout
# has been reached, close the socket, drop all previously buffered data,
# and return. If the establishment timeout has not been reached, return.
if (!socket_ready($new_sockets->{$peer}->{"socket"}, 1)) {
if (time() - $new_sockets->{$peer}->{"time"} > $socket_timeout) {
log_msg(LOG_DEBUG, "Can't connect to $peertype '$peer'",
"(connection establishment timeout)");
delete $new_sockets->{$peer};
}
return;
}
# If socket is writable, try to transmit all buffered events.
# In the case of hard errors from send(2), retransmission is not attempted
# and data are not buffered, but socket is closed (note that if connection
# establishment completed with error, sending the first buffered event will
# produce a hard send(2) error and socket will be closed).
foreach $event (@{$new_sockets->{$peer}->{"buffer"}}) {
if (!send_to_socket($new_sockets->{$peer}->{"socket"}, $event,
"$peertype '$peer'")) {
delete $new_sockets->{$peer};
return;
}
}
$est_sockets->{$peer} = $new_sockets->{$peer}->{"socket"};
delete $new_sockets->{$peer};
}
# Parameters: par1 - reference to a list of actions
# par2 - event description text
# par3 - pointer into the list of actions
# Action: execute an action from a given action list, and return
# an offset for advancing the pointer par3
sub execute_none_action { return 1; }
sub execute_logonly_action {
my($actionlist, $text, $i) = @_;
my($event);
$event = $actionlist->[$i+1];
substitute_actionlist_var($event, $text);
log_msg(LOG_NOTICE, $event);
return 2;
}
sub execute_write_action {
my($actionlist, $text, $i) = @_;
my($action, $file, $event);
my($handle, $nbytes, $len);
# since this function is used for both 'write' and 'writen' actions,
# set $action to the action type
$action = $actionlist->[$i];
$file = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($file, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors are
# logged at the debug level, in order to prevent message floods with
# higher severity when larger amounts of data are transfered
log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'");
if (!exists($output_files{$file})) {
if ($file eq "-") {
while (!open($handle, ">&STDOUT")) {
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't dup stdout for writing event '$event' ($!)");
return 3;
}
$output_files{$file} = $handle;
} elsif (-e $file && ! -f $file && ! -p $file) {
log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'",
"(not a regular file or pipe)");
return 3;
} elsif (-p $file) {
while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
return 3;
}
$output_files{$file} = $handle;
} else {
while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
return 3;
}
$output_files{$file} = $handle;
}
}
for (;;) {
# if the event contains perl wide characters, syswrite() will die,
# thus eval is used for calling it
if ($action == WRITE) {
$len = length($event) + 1;
$nbytes = eval { syswrite($output_files{$file}, "$event\n") };
} else {
$len = length($event);
$nbytes = eval { syswrite($output_files{$file}, "$event") };
}
if ($@) {
log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)");
} elsif (!defined($nbytes)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)");
delete $output_files{$file};
} elsif ($nbytes != $len) {
log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'");
}
return 3;
}
}
sub execute_closef_action {
my($actionlist, $text, $i) = @_;
my($file);
$file = $actionlist->[$i+1];
substitute_actionlist_var($file, $text);
log_msg(LOG_DEBUG, "Closing file '$file'");
if (exists($output_files{$file})) {
if (!close($output_files{$file})) {
log_msg(LOG_WARN, "Error when closing file '$file' ($!)");
}
delete $output_files{$file};
} else {
log_msg(LOG_DEBUG, "File '$file' is not open, can't close");
}
return 2;
}
sub execute_owritecl_action {
my($actionlist, $text, $i) = @_;
my($file, $event, $handle, $nbytes);
$file = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($file, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors are
# logged at the debug level, in order to prevent message floods with
# higher severity when larger amounts of data are transfered
log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'");
if ($file eq "-") {
select(STDOUT);
$| = 1;
print STDOUT "$event";
return 3;
} elsif (-e $file && ! -f $file && ! -p $file) {
log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'",
"(not a regular file or pipe)");
return 3;
} elsif (-p $file) {
while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
return 3;
}
} else {
while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
return 3;
}
}
for (;;) {
# if the event contains perl wide characters, syswrite() will die,
# thus eval is used for calling it
$nbytes = eval { syswrite($handle, $event) };
if ($@) {
log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)");
} elsif (!defined($nbytes)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)");
} elsif ($nbytes != length($event)) {
log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'");
}
close($handle);
return 3;
}
}
sub execute_udgram_action {
my($actionlist, $text, $i) = @_;
my($file, $event, $handle);
$file = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($file, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors with
# local peers are logged at the debug level, in order to prevent message
# floods with higher severity when large amounts of data are transfered
log_msg(LOG_DEBUG, "Sending event '$event' to unix datagram socket '$file'");
# if the socket already exists, use it for transmitting data; if the
# transmission fails with hard error from send(2) (e.g., the server has
# been restarted and the socket file has been recreated), close the socket
# and attempt retransmission, otherwise return immediately
if (exists($output_udgram{$file})) {
if (send_to_socket($output_udgram{$file}, $event, "socket '$file'")) {
return 3;
}
log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'");
delete $output_udgram{$file};
}
# create the socket for communicating with local peer
if (! -S $file) {
log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'",
"(socket does not exist)");
return 3;
}
if (!socket($handle, PF_UNIX, SOCK_DGRAM, 0)) {
log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)");
return 3;
}
# Connect to local peer (connect() returns immediately for connectionless
# sockets). Since EINTR error should not happen for connectionless sockets
# on posix systems and on many platforms connect() should not be called
# again after EINTR, there is no special handling for EINTR.
if (!connect($handle, sockaddr_un($file))) {
log_msg(LOG_DEBUG,
"Can't connect to socket '$file' for sending event '$event' ($!)");
return 3;
}
# switch the socket to non-blocking mode for all further communications
$handle->blocking(0);
$output_udgram{$file} = $handle;
# transmit data to local peer (close the socket on hard send(2) error)
if (!send_to_socket($output_udgram{$file}, $event, "socket '$file'")) {
delete $output_udgram{$file};
}
return 3;
}
sub execute_closeudgr_action {
my($actionlist, $text, $i) = @_;
my($file);
$file = $actionlist->[$i+1];
substitute_actionlist_var($file, $text);
log_msg(LOG_DEBUG, "Closing unix datagram socket '$file'");
if (exists($output_udgram{$file})) {
if (!close($output_udgram{$file})) {
log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
}
delete $output_udgram{$file};
} else {
log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close");
}
return 2;
}
sub execute_ustream_action {
my($actionlist, $text, $i) = @_;
my($file, $event, $handle);
$file = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($file, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors with
# local peers are logged at the debug level, in order to prevent message
# floods with higher severity when large amounts of data are transfered
log_msg(LOG_DEBUG, "Sending event '$event' to unix stream socket '$file'");
# If the socket exists and there is an established connection to local
# peer, send data to the peer. If sending failed with a hard error from
# send(2), close the socket and attempt resending with a newly created
# socket later in the function, otherwise return immediately.
if (exists($output_ustream{$file})) {
if (send_to_socket($output_ustream{$file}, $event, "socket '$file'")) {
return 3;
}
log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'");
delete $output_ustream{$file};
}
# the socket exists but the connection establishment is not complete
elsif (exists($output_ustrconn{$file})) {
# buffer the event
push @{$output_ustrconn{$file}->{"buffer"}}, $event;
# Check the status of the connection, and if the connection establishment
# has completed, try to transmit all buffered events. If no hard send(2)
# errors were encountered during transmission, regard the connection as
# successfully established, and move the socket from %output_ustrconn hash
# to %output_ustream hash. Otherwise, close the socket.
check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket");
return 3;
}
# If the socket did not exist previously or the established connection
# was closed because of an error, recreate the socket and attempt to
# establish a new connection for transmitting data to local peer
if (! -S $file) {
log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'",
"(socket does not exist)");
return 3;
}
if (!socket($handle, PF_UNIX, SOCK_STREAM, 0)) {
log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)");
return 3;
}
# Connect to local peer -- although calling connect() for blocking unix
# stream socket will usually return immediately, there are cases when
# connect() might block (e.g., on Linux when server listen backlog is full).
# For handling such cases, the socket will be switched to non-blocking
# mode before calling connect(). If the connection to local peer is not
# established immediately (EINPROGRESS on posix systems), buffer the data
# for future transmission and return. Note that on Linux EINPROGRESS is
# never returned for unix stream sockets, but rather EAGAIN which is never
# returned on posix systems. Since EINTR error should not happen on posix
# systems for non-blocking sockets, and on many platforms connect() should
# not be called again after EINTR, there is no special handling for EINTR.
$handle->blocking(0);
if (!connect($handle, sockaddr_un($file))) {
if ($! == EINPROGRESS || $! == EAGAIN) {
$output_ustrconn{$file} = { "socket" => $handle,
"buffer" => [ $event ],
"time" => time() };
} else {
log_msg(LOG_DEBUG,
"Can't connect to socket '$file' for sending event '$event' ($!)");
}
return 3;
}
$output_ustream{$file} = $handle;
# transmit data to local peer (close the socket on hard send(2) error)
if (!send_to_socket($output_ustream{$file}, $event, "socket '$file'")) {
delete $output_ustream{$file};
}
return 3;
}
sub execute_closeustr_action {
my($actionlist, $text, $i) = @_;
my($file);
$file = $actionlist->[$i+1];
substitute_actionlist_var($file, $text);
log_msg(LOG_DEBUG, "Closing unix stream socket '$file'");
if (exists($output_ustream{$file})) {
if (!close($output_ustream{$file})) {
log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
}
delete $output_ustream{$file};
} elsif (exists($output_ustrconn{$file})) {
if (!close($output_ustrconn{$file}->{"socket"})) {
log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
}
delete $output_ustrconn{$file};
} else {
log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close");
}
return 2;
}
sub execute_udpsock_action {
my($actionlist, $text, $i) = @_;
my($peer, $event, $host, $port, $handle, $addr);
$peer = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($peer, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors with
# remote peers are logged at the debug level, in order to prevent message
# floods with higher severity when large amounts of data are transfered
log_msg(LOG_DEBUG, "Sending event '$event' to UDP peer '$peer'");
# if the socket already exists, use it for transmitting data; if the
# transmission fails with hard error from send(2) (e.g., server responded
# with ICMP port unreachable to previous transmission which raises an error
# condition for the socket), close the socket and attempt retransmission,
# otherwise return immediately
if (exists($output_udpsock{$peer})) {
if (send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) {
return 3;
}
log_msg(LOG_DEBUG, "Retrying to send event '$event' to UDP peer '$peer'");
delete $output_udpsock{$peer};
}
# create the socket for communicating with remote peer
if ($peer !~ /^(.+):([0-9]+)$/) {
log_msg(LOG_WARN,
"Can't connect to UDP peer '$peer' for sending event '$event'",
"(peer not in host:portnumber format)");
return 3;
}
$host = $1;
$port = $2;
($handle, $addr) = create_sock_addr($host, $port, "udp");
if (!defined($handle)) {
log_msg(LOG_DEBUG,
"Can't connect to UDP peer '$peer' for sending event '$event'");
return 3;
}
# Connect to remote peer (connect() returns immediately for connectionless
# sockets). Since EINTR error should not happen for connectionless sockets
# on posix systems, and on many platforms connect() should not be called
# again after EINTR, there is no special handling for EINTR.
if (!connect($handle, $addr)) {
log_msg(LOG_DEBUG,
"Can't connect to UDP peer '$peer' for sending event '$event' ($!)");
return 3;
}
# switch the socket to non-blocking mode for all further communications
$handle->blocking(0);
$output_udpsock{$peer} = $handle;
# transmit data to remote peer (close the socket on hard send(2) error)
if (!send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) {
delete $output_udpsock{$peer};
}
return 3;
}
sub execute_closeudp_action {
my($actionlist, $text, $i) = @_;
my($peer);
$peer = $actionlist->[$i+1];
substitute_actionlist_var($peer, $text);
log_msg(LOG_DEBUG, "Closing socket for UDP peer '$peer'");
if (exists($output_udpsock{$peer})) {
if (!close($output_udpsock{$peer})) {
log_msg(LOG_WARN, "Error when closing socket for UDP peer '$peer' ($!)");
}
delete $output_udpsock{$peer};
} else {
log_msg(LOG_DEBUG, "No socket for UDP peer '$peer', can't close");
}
return 2;
}
sub execute_tcpsock_action {
my($actionlist, $text, $i) = @_;
my($peer, $event, $host, $port, $handle, $addr);
$peer = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($peer, $text);
substitute_actionlist_var($event, $text);
# apart from unexpected local system errors, communication errors with
# remote peers are logged at the debug level, in order to prevent message
# floods with higher severity when large amounts of data are transfered
log_msg(LOG_DEBUG, "Sending event '$event' to TCP peer '$peer'");
# If the socket exists and there is an established connection to remote
# peer, send data to the peer. If sending failed with a hard error from
# send(2), close the socket and attempt resending with a newly created
# socket later in the function, otherwise return immediately.
if (exists($output_tcpsock{$peer})) {
if (send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) {
return 3;
}
log_msg(LOG_DEBUG, "Retrying to send event '$event' to TCP peer '$peer'");
delete $output_tcpsock{$peer};
}
# the socket exists but the connection establishment is not complete
elsif (exists($output_tcpconn{$peer})) {
# buffer the event
push @{$output_tcpconn{$peer}->{"buffer"}}, $event;
# Check the status of the connection, and if the connection establishment
# has completed, try to transmit all buffered events. If no hard send(2)
# errors were encountered during transmission, regard the connection as
# successfully established, and move the socket from %output_tcpconn hash
# to %output_tcpsock hash. Otherwise, close the socket.
check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer");
return 3;
}
# If the socket did not exist previously or the established connection
# was closed because of an error, recreate the socket and attempt to
# establish a new connection for transmitting data to remote peer
if ($peer !~ /^(.+):([0-9]+)$/) {
log_msg(LOG_WARN,
"Can't connect to TCP peer '$peer' for sending event '$event'",
"(peer not in host:portnumber format)");
return 3;
}
$host = $1;
$port = $2;
($handle, $addr) = create_sock_addr($host, $port, "tcp");
if (!defined($handle)) {
log_msg(LOG_DEBUG,
"Can't connect to TCP peer '$peer' for sending event '$event'");
return 3;
}
# Connect to remote peer -- for avoiding blocking connect(), socket will be
# switched to non-blocking mode before calling connect(). If the connection
# to remote peer is not established immediately (EINPROGRESS), buffer the
# data for future transmission and return. Since EINTR error should not
# happen on posix systems for non-blocking sockets, and on many platforms
# connect() should not be called again after EINTR, there is no special
# handling for EINTR.
$handle->blocking(0);
if (!connect($handle, $addr)) {
if ($! == EINPROGRESS) {
$output_tcpconn{$peer} = { "socket" => $handle,
"buffer" => [ $event ],
"time" => time() };
} else {
log_msg(LOG_DEBUG,
"Can't connect to TCP peer '$peer' for sending event '$event' ($!)");
}
return 3;
}
$output_tcpsock{$peer} = $handle;
# transmit data to remote peer (close the socket on hard send(2) error)
if (!send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) {
delete $output_tcpsock{$peer};
}
return 3;
}
sub execute_closetcp_action {
my($actionlist, $text, $i) = @_;
my($peer);
$peer = $actionlist->[$i+1];
substitute_actionlist_var($peer, $text);
log_msg(LOG_DEBUG, "Closing socket for TCP peer '$peer'");
if (exists($output_tcpsock{$peer})) {
if (!close($output_tcpsock{$peer})) {
log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)");
}
delete $output_tcpsock{$peer};
} elsif (exists($output_tcpconn{$peer})) {
if (!close($output_tcpconn{$peer}->{"socket"})) {
log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)");
}
delete $output_tcpconn{$peer};
} else {
log_msg(LOG_DEBUG, "No socket for TCP peer '$peer', can't close");
}
return 2;
}
sub execute_shellcmd_action {
my($actionlist, $text, $i) = @_;
my($cmdline, $text2);
$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_actionlist_var($cmdline, $text2);
log_msg(LOG_INFO, "Executing shell command '$cmdline'");
exec_cmd($cmdline);
return 2;
}
sub execute_cmdexec_action {
my($actionlist, $text, $i) = @_;
my(@cmdline, $cmdline, $arg);
@cmdline = @{$actionlist->[$i+1]};
foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); }
$cmdline = join(" ", @cmdline);
log_msg(LOG_INFO, "Executing command '$cmdline'");
exec_cmd(\@cmdline);
return 2;
}
sub execute_spawn_action {
my($actionlist, $text, $i) = @_;
my($cmdline, $text2);
$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_actionlist_var($cmdline, $text2);
log_msg(LOG_INFO, "Spawning shell command '$cmdline'");
exec_cmd($cmdline, 1);
return 2;
}
sub execute_spawnexec_action {
my($actionlist, $text, $i) = @_;
my(@cmdline, $cmdline, $arg);
@cmdline = @{$actionlist->[$i+1]};
foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); }
$cmdline = join(" ", @cmdline);
log_msg(LOG_INFO, "Spawning command '$cmdline'");
exec_cmd(\@cmdline, 1);
return 2;
}
sub execute_cspawn_action {
my($actionlist, $text, $i) = @_;
my($context, $cmdline, $text2);
$context = $actionlist->[$i+1];
$cmdline = $actionlist->[$i+2];
$text2 = $text;
# if -quoting flag was specified, mask apostrophes in $text2
# and put $text2 inside apostrophes
if ($quoting) {
$text2 =~ s/'/'\\''/g;
$text2 = "'" . $text2 . "'";
}
substitute_actionlist_var($context, $text2);
substitute_actionlist_var($cmdline, $text2);
log_msg(LOG_INFO,
"Spawning shell command '$cmdline' with context '$context'");
exec_cmd($cmdline, 1, $context);
return 3;
}
sub execute_cspawnexec_action {
my($actionlist, $text, $i) = @_;
my(@cmdline, $cmdline, $context, $arg);
$context = $actionlist->[$i+1];
@cmdline = @{$actionlist->[$i+2]};
substitute_actionlist_var($context, $text);
foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); }
$cmdline = join(" ", @cmdline);
log_msg(LOG_INFO, "Spawning command '$cmdline' with context '$context'");
exec_cmd(\@cmdline, 1, $context);
return 3;
}
sub execute_pipe_action {
my($actionlist, $text, $i) = @_;
my($event, $cmdline);
$event = $actionlist->[$i+1];
$cmdline = $actionlist->[$i+2];
substitute_actionlist_var($event, $text);
substitute_actionlist_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";
}
return 3;
}
sub execute_pipeexec_action {
my($actionlist, $text, $i) = @_;
my(@cmdline, $cmdline, $event, $arg);
$event = $actionlist->[$i+1];
@cmdline = @{$actionlist->[$i+2]};
substitute_actionlist_var($event, $text);
foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); }
$cmdline = join(" ", @cmdline);
log_msg(LOG_INFO, "Feeding event '$event' to command '$cmdline'");
if (scalar(@cmdline)) {
pipe_cmd(\@cmdline, [ $event ]);
} else {
select(STDOUT);
$| = 1;
print STDOUT "$event\n";
}
return 3;
}
sub execute_create_action {
my($actionlist, $text, $i) = @_;
my($context, $lifetime, $list);
$context = $actionlist->[$i+1];
$lifetime = $actionlist->[$i+2];
$list = $actionlist->[$i+3];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($lifetime, $text);
log_msg(LOG_DEBUG, "Creating context '$context'");
if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) {
$lifetime = $1;
if (exists($context_list{$context})) {
if (!exists($context_list{$context}->{"Internal"})) {
$context_list{$context}->{"Time"} = time();
$context_list{$context}->{"Window"} = $lifetime;
$context_list{$context}->{"Action"} = $list;
$context_list{$context}->{"Desc"} = $text;
@{$context_list{$context}->{"Buffer"}} = ();
} else {
log_msg(LOG_WARN,
"Invalid use of create action for internal context '$context'");
}
} else {
$context_list{$context} = { "Time" => time(),
"Window" => $lifetime,
"Buffer" => [],
"Action" => $list,
"Desc" => $text,
"Aliases" => { $context => 1 } };
}
} else {
log_msg(LOG_WARN,
"Invalid lifetime '$lifetime' for context '$context', can't create");
}
return 4;
}
sub execute_delete_action {
my($actionlist, $text, $i) = @_;
my($context, $alias);
$context = $actionlist->[$i+1];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Deleting context '$context'");
if (exists($context_list{$context}) &&
!exists($context_list{$context}->{"DeleteInProgress"})) {
if (!exists($context_list{$context}->{"Internal"})) {
foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) {
delete $context_list{$alias};
log_msg(LOG_DEBUG, "Context '$alias' deleted");
}
} else {
log_msg(LOG_WARN,
"Invalid use of delete action for internal context '$context'");
}
} else {
log_msg(LOG_DEBUG,
"Context '$context' does not exist or is already going through deletion");
}
return 2;
}
sub execute_obsolete_action {
my($actionlist, $text, $i) = @_;
my($context);
$context = $actionlist->[$i+1];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Obsoleting context '$context'");
if (exists($context_list{$context}) &&
!exists($context_list{$context}->{"DeleteInProgress"})) {
if (!exists($context_list{$context}->{"Internal"})) {
$context_list{$context}->{"Window"} = -1;
valid_context($context);
} else {
log_msg(LOG_WARN,
"Invalid use of obsolete action for internal context '$context'");
}
} else {
log_msg(LOG_DEBUG,
"Context '$context' does not exist or is already going through deletion");
}
return 2;
}
sub execute_set_action {
my($actionlist, $text, $i) = @_;
my($context, $lifetime, $list);
$context = $actionlist->[$i+1];
$lifetime = $actionlist->[$i+2];
$list = $actionlist->[$i+3];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($lifetime, $text);
log_msg(LOG_DEBUG, "Changing settings for context '$context'");
if ($lifetime =~ /^\s*(?:0*([0-9]+)|-)\s*$/) {
$lifetime = $1;
if (exists($context_list{$context})) {
if (!exists($context_list{$context}->{"Internal"})) {
if (defined($lifetime)) {
$context_list{$context}->{"Time"} = time();
$context_list{$context}->{"Window"} = $lifetime;
}
if (scalar(@{$list})) {
$context_list{$context}->{"Action"} = $list;
$context_list{$context}->{"Desc"} = $text;
}
} else {
log_msg(LOG_WARN,
"Invalid use of set action for internal context '$context'");
}
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't change settings");
}
} else {
log_msg(LOG_WARN,
"Invalid lifetime '$lifetime' for context '$context', can't change settings");
}
return 4;
}
sub execute_alias_action {
my($actionlist, $text, $i) = @_;
my($context, $alias);
$context = $actionlist->[$i+1];
$alias = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_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_DEBUG, "Alias '$alias' already exists");
} elsif (!exists($context_list{$context}->{"Internal"})) {
$context_list{$context}->{"Aliases"}->{$alias} = 1;
$context_list{$alias} = $context_list{$context};
} else {
log_msg(LOG_WARN,
"Invalid use of alias action for internal context '$context'");
}
return 3;
}
sub execute_unalias_action {
my($actionlist, $text, $i) = @_;
my($alias);
$alias = $actionlist->[$i+1];
substitute_actionlist_var($alias, $text);
log_msg(LOG_DEBUG, "Removing alias '$alias'");
if (exists($context_list{$alias}) &&
!exists($context_list{$alias}->{"DeleteInProgress"})) {
if (!exists($context_list{$alias}->{"Internal"})) {
delete $context_list{$alias}->{"Aliases"}->{$alias};
if (!scalar(%{$context_list{$alias}->{"Aliases"}})) {
log_msg(LOG_DEBUG,
"Alias '$alias' was the last reference to a context");
}
delete $context_list{$alias};
} else {
log_msg(LOG_WARN,
"Invalid use of unalias action for internal context '$alias'");
}
} else {
log_msg(LOG_DEBUG, "Alias '$alias' does not exist or the referred context is already going through deletion");
}
return 2;
}
sub execute_add_action {
my($actionlist, $text, $i) = @_;
my($context, $event, @event);
$context = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($event, $text);
log_msg(LOG_DEBUG, "Adding event(s) '$event' to context '$context'");
if (!exists($context_list{$context})) {
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "",
"Aliases" => { $context => 1 } };
}
if (!exists($context_list{$context}->{"Internal"})) {
@event = split(/\n/, $event); # split returns empty list for "" or undef
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(s) '$event' to context '$context', store full");
}
} else {
log_msg(LOG_WARN,
"Invalid use of add action for internal context '$context'");
}
return 3;
}
sub execute_prepend_action {
my($actionlist, $text, $i) = @_;
my($context, $event, @event);
$context = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($event, $text);
log_msg(LOG_DEBUG, "Prepending event(s) '$event' to context '$context'");
if (!exists($context_list{$context})) {
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "",
"Aliases" => { $context => 1 } };
}
if (!exists($context_list{$context}->{"Internal"})) {
@event = split(/\n/, $event); # split returns empty list for "" or undef
if (!$evstoresize || scalar(@{$context_list{$context}->{"Buffer"}})
+ scalar(@event) <= $evstoresize) {
unshift @{$context_list{$context}->{"Buffer"}}, @event;
} else {
log_msg(LOG_WARN,
"Can't prepend event(s) '$event' to context '$context', store full");
}
} else {
log_msg(LOG_WARN,
"Invalid use of prepend action for internal context '$context'");
}
return 3;
}
sub execute_fill_action {
my($actionlist, $text, $i) = @_;
my($context, $event, @event);
$context = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($event, $text);
log_msg(LOG_DEBUG, "Filling context '$context' with event(s) '$event'");
if (!exists($context_list{$context})) {
$context_list{$context} = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "",
"Aliases" => { $context => 1 } };
}
if (!exists($context_list{$context}->{"Internal"})) {
@event = split(/\n/, $event); # split returns empty list for "" or undef
if (!$evstoresize || scalar(@event) <= $evstoresize) {
@{$context_list{$context}->{"Buffer"}} = @event;
} else {
log_msg(LOG_WARN,
"Can't fill context '$context' with event(s) '$event', store full");
}
} else {
log_msg(LOG_WARN,
"Invalid use of fill action for internal context '$context'");
}
return 3;
}
sub execute_report_action {
my($actionlist, $text, $i) = @_;
my($context, $cmdline, $event);
$context = $actionlist->[$i+1];
$cmdline = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_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_DEBUG,
"Event store of context '$context' is empty, nothing to 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";
}
}
}
return 3;
}
sub execute_reportexec_action {
my($actionlist, $text, $i) = @_;
my(@cmdline, $cmdline, $context, $event, $arg);
$context = $actionlist->[$i+1];
@cmdline = @{$actionlist->[$i+2]};
substitute_actionlist_var($context, $text);
foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); }
$cmdline = join(" ", @cmdline);
log_msg(LOG_INFO, "Reporting the event store of context '$context' through 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_DEBUG,
"Event store of context '$context' is empty, nothing to report");
} else {
if (scalar(@cmdline)) {
pipe_cmd(\@cmdline, $context_list{$context}->{"Buffer"});
} else {
select(STDOUT);
$| = 1;
foreach $event (@{$context_list{$context}->{"Buffer"}}) {
print STDOUT "$event\n";
}
}
}
return 3;
}
sub execute_copy_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_actionlist_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");
}
return 3;
}
sub execute_empty_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_actionlist_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");
}
return 3;
}
sub execute_pop_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Pop the last element of context '$context' event store into variable '%$variable'");
if (exists($context_list{$context})) {
$value = pop @{$context_list{$context}->{"Buffer"}};
if (!defined($value)) { $value = ""; }
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't pop");
}
return 3;
}
sub execute_shift_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$context = $actionlist->[$i+1];
$variable = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Shift the first element of context '$context' event store into variable '%$variable'");
if (exists($context_list{$context})) {
$value = shift @{$context_list{$context}->{"Buffer"}};
if (!defined($value)) { $value = ""; }
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't shift");
}
return 3;
}
sub execute_exists_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$variable = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Checking the presence of context '$context'");
$value = (exists($context_list{$context}))?1:0;
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
return 3;
}
sub execute_getsize_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$variable = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Finding the size of context '$context' event store");
if (exists($context_list{$context})) {
$value = scalar(@{$context_list{$context}->{"Buffer"}});
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
$variables{$variable} = undef;
log_msg(LOG_DEBUG,
"Context '$context' does not exist, variable '%$variable' set to undef");
}
return 3;
}
sub execute_getaliases_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$variable = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG,
"Assigning aliases of context '$context' to variable '%$variable'");
if (exists($context_list{$context})) {
$value = join("\n", keys %{$context_list{$context}->{"Aliases"}});
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't get aliases");
}
return 3;
}
sub execute_getltime_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$variable = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG,
"Assigning the lifetime of context '$context' to variable '%$variable'");
if (exists($context_list{$context})) {
$value = $context_list{$context}->{"Window"};
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN, "Context '$context' does not exist, can't get lifetime");
}
return 3;
}
sub execute_setltime_action {
my($actionlist, $text, $i) = @_;
my($context, $lifetime);
$context = $actionlist->[$i+1];
$lifetime = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($lifetime, $text);
if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) {
$lifetime = $1;
log_msg(LOG_DEBUG,
"Setting the lifetime of context '$context' to '$lifetime'");
if (exists($context_list{$context})) {
if (!exists($context_list{$context}->{"Internal"})) {
$context_list{$context}->{"Window"} = $lifetime;
if ($lifetime &&
time() - $context_list{$context}->{"Time"} > $lifetime) {
log_msg(LOG_DEBUG,
"Context '$context' has become stale after lifetime adjustment");
valid_context($context);
}
} else {
log_msg(LOG_WARN,
"Invalid use of setltime action for internal context '$context'");
}
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't set lifetime");
}
} else {
log_msg(LOG_WARN, "Invalid lifetime '$lifetime' for context '$context'");
}
return 3;
}
sub execute_getctime_action {
my($actionlist, $text, $i) = @_;
my($context, $variable, $value);
$variable = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG,
"Assigning the creation time of context '$context' to variable '%$variable'");
if (exists($context_list{$context})) {
$value = $context_list{$context}->{"Time"};
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't get creation time");
}
return 3;
}
sub execute_setctime_action {
my($actionlist, $text, $i) = @_;
my($context, $timestamp);
my($ltime, $time, $time2);
$timestamp = $actionlist->[$i+1];
$context = $actionlist->[$i+2];
substitute_actionlist_var($timestamp, $text);
substitute_actionlist_var($context, $text);
if ($timestamp =~ /^\s*0*([0-9]+)\s*$/) {
$timestamp = $1;
$ltime = scalar(localtime($timestamp));
log_msg(LOG_DEBUG,
"Setting the creation time of context '$context' to '$ltime'");
if (exists($context_list{$context})) {
if (!exists($context_list{$context}->{"Internal"})) {
$time = $context_list{$context}->{"Time"};
$time2 = time();
if ($timestamp < $time) {
log_msg(LOG_WARN,
"Can't set context creation time backwards to '$ltime'");
} elsif ($timestamp > $time2) {
log_msg(LOG_WARN,
"Can't set context creation time into future to '$ltime'");
} elsif ($timestamp == $time) {
log_msg(LOG_DEBUG, "Context creation time already set to '$ltime'");
} else {
$context_list{$context}->{"Time"} = $timestamp;
}
} else {
log_msg(LOG_WARN,
"Invalid use of setctime action for internal context '$context'");
}
} else {
log_msg(LOG_WARN,
"Context '$context' does not exist, can't set creation time");
}
} else {
log_msg(LOG_WARN,
"Invalid timestamp '$timestamp' for creation time of context '$context'");
}
return 3;
}
sub execute_event_action {
my($actionlist, $text, $i) = @_;
my($createafter, $event, @event);
$createafter = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($event, $text);
@event = split(/\n/, $event); # split returns empty list for "" or undef
if ($createafter) {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds");
push @pending_events, [ time() + $createafter, $event,
SYNEVENT_INT_CONTEXT ];
}
} else {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Creating event '$event'");
push @events, $event, SYNEVENT_INT_CONTEXT;
}
}
return 3;
}
sub execute_tevent_action {
my($actionlist, $text, $i) = @_;
my($createafter, $event, @event);
$createafter = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($createafter, $text);
substitute_actionlist_var($event, $text);
@event = split(/\n/, $event); # split returns empty list for "" or undef
if ($createafter =~ /^\s*0*([0-9]+)\s*$/) {
$createafter = $1;
if ($createafter) {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds");
push @pending_events, [ time() + $createafter, $event,
SYNEVENT_INT_CONTEXT ];
}
} else {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Creating event '$event'");
push @events, $event, SYNEVENT_INT_CONTEXT;
}
}
} else {
log_msg(LOG_WARN,
"Invalid time specification '$createafter' for creating events");
}
return 3;
}
sub execute_cevent_action {
my($actionlist, $text, $i) = @_;
my($context, $createafter, $event, @event);
$context = $actionlist->[$i+1];
$createafter = $actionlist->[$i+2];
$event = $actionlist->[$i+3];
substitute_actionlist_var($context, $text);
substitute_actionlist_var($createafter, $text);
substitute_actionlist_var($event, $text);
@event = split(/\n/, $event); # split returns empty list for "" or undef
if ($createafter =~ /^\s*0*([0-9]+)\s*$/) {
$createafter = $1;
if ($createafter) {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' with context '$context' after $createafter seconds");
push @pending_events, [ time() + $createafter, $event, $context ];
}
} else {
foreach $event (@event) {
log_msg(LOG_DEBUG, "Creating event '$event' with context '$context'");
push @events, $event, $context;
}
}
} else {
log_msg(LOG_WARN,
"Invalid time specification '$createafter' for creating events");
}
return 4;
}
sub execute_reset_action {
my($actionlist, $text, $i) = @_;
my($conffile, $ruleid, $event);
my($key, $rule);
$conffile = $actionlist->[$i+1];
$ruleid = $actionlist->[$i+2];
$event = $actionlist->[$i+3];
substitute_actionlist_var($event, $text);
if (length($ruleid)) {
$key = gen_key($conffile, $ruleid, $event);
log_msg(LOG_DEBUG, "Terminating event correlation operation '$key'");
$rule = $configuration{$conffile}->[$ruleid];
if (exists($rule->{"Operations"})) {
delete $rule->{"Operations"}->{$key};
}
delete $corr_list{$key};
} else {
log_msg(LOG_DEBUG,
"Terminating all event correlation operations started from",
$conffile, "with operation description string '$event'");
foreach $rule (@{$configuration{$conffile}}) {
$key = gen_key($conffile, $rule->{"ID"}, $event);
if (exists($rule->{"Operations"})) {
delete $rule->{"Operations"}->{$key};
}
delete $corr_list{$key};
}
}
return 4;
}
sub execute_getwpos_action {
my($actionlist, $text, $i) = @_;
my($variable, $conffile, $ruleid, $event);
my($key, $time);
$variable = $actionlist->[$i+1];
$conffile = $actionlist->[$i+2];
$ruleid = $actionlist->[$i+3];
$event = $actionlist->[$i+4];
substitute_actionlist_var($event, $text);
$key = gen_key($conffile, $ruleid, $event);
log_msg(LOG_DEBUG,
"Getting event correlation window position for operation '$key'");
if (exists($corr_list{$key})) {
$time = $corr_list{$key}->{"Time"};
$variables{$variable} = $time;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$time'");
} else {
log_msg(LOG_WARN,
"Operation '$key' does not exist, can't get window position");
}
return 5;
}
sub execute_setwpos_action {
my($actionlist, $text, $i) = @_;
my($timestamp, $conffile, $ruleid, $event);
my($key, $oper, $ltime, $time, $time2);
$timestamp = $actionlist->[$i+1];
$conffile = $actionlist->[$i+2];
$ruleid = $actionlist->[$i+3];
$event = $actionlist->[$i+4];
substitute_actionlist_var($timestamp, $text);
substitute_actionlist_var($event, $text);
$key = gen_key($conffile, $ruleid, $event);
if ($timestamp !~ /^\s*0*([0-9]+)\s*$/) {
log_msg(LOG_WARN,
"Invalid timestamp '$timestamp' for moving the window of operation '$key'");
return 5;
}
$timestamp = $1;
$ltime = scalar(localtime($timestamp));
log_msg(LOG_DEBUG,
"Moving event correlation window to '$ltime' for operation '$key'");
if (!exists($corr_list{$key})) {
log_msg(LOG_WARN,
"Operation '$key' does not exist, can't set window position");
return 5;
}
$oper = $corr_list{$key};
$time = $oper->{"Time"};
$time2 = time();
if (exists($oper->{"InitInProgress"})) {
log_msg(LOG_WARN,
"Operation '$key' is initializing, can't set window position");
return 5;
}
if (exists($oper->{"DeleteInProgress"})) {
log_msg(LOG_WARN,
"Operation '$key' is terminating, can't set window position");
return 5;
}
if ($timestamp < $time) {
log_msg(LOG_WARN,
"Can't move event correlation window backwards to '$ltime'");
return 5;
}
if ($timestamp > $time2) {
log_msg(LOG_WARN,
"Can't move event correlation window into future to '$ltime'");
return 5;
}
if ($timestamp == $time) {
log_msg(LOG_DEBUG,
"Event correlation window is already positioned at '$ltime'");
return 5;
}
if ($oper->{"Type"} == SINGLE_W_THRESHOLD) {
if (!exists($oper->{"SuppressMode"})) {
update_times_swt($oper, $timestamp, 1);
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
$oper->{"Time"} = $timestamp;
}
} elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) {
if (!exists($oper->{"2ndPass"})) {
update_times_swt($oper, $timestamp, 1);
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
update_times_swt($oper, $timestamp, 1);
}
} elsif ($oper->{"Type"} == EVENT_GROUP) {
if (!exists($oper->{"SuppressMode"})) {
update_times_eg($oper, $timestamp, 1);
if (!scalar(@{$oper->{"AllTimes"}})) {
$oper->{"DeleteInProgress"} = 1;
execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
delete $corr_list{$key};
}
} else {
$oper->{"Time"} = $timestamp;
}
} else { $oper->{"Time"} = $timestamp; }
if (!exists($corr_list{$key})) {
log_msg(LOG_DEBUG,
"Operation '$key' finished its work after window was moved");
}
return 5;
}
sub execute_assign_action {
my($actionlist, $text, $i) = @_;
my($variable, $value);
$variable = $actionlist->[$i+1];
$value = $actionlist->[$i+2];
substitute_actionlist_var($value, $text);
log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'");
$variables{$variable} = $value;
return 3;
}
sub execute_assignsq_action {
my($actionlist, $text, $i) = @_;
my($variable, $value);
$variable = $actionlist->[$i+1];
$value = $actionlist->[$i+2];
substitute_actionlist_var($value, $text);
$value =~ s/'/'\\''/g;
$value = "'" . $value . "'";
log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'");
$variables{$variable} = $value;
return 3;
}
sub execute_free_action {
my($actionlist, undef, $i) = @_;
my($variable);
$variable = $actionlist->[$i+1];
log_msg(LOG_DEBUG, "Freeing variable '%$variable'");
delete $variables{$variable};
return 2;
}
sub execute_eval_action {
my($actionlist, $text, $i) = @_;
my($variable, $code);
my(@retval, $evalok, $value);
$variable = $actionlist->[$i+1];
$code = $actionlist->[$i+2];
substitute_actionlist_var($code, $text);
log_msg(LOG_DEBUG,
"Evaluating code '$code' and setting variable '%$variable'");
@retval = SEC::call_eval($code, 1);
$evalok = shift @retval;
if ($evalok) {
foreach $value (@retval) { if (!defined($value)) { $value = ""; } }
if (scalar(@retval) > 1) {
$value = join("\n", @retval);
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} elsif (scalar(@retval) == 1) {
# this check is needed for cases when 'eval' returns a code reference,
# because join() converts it to a string and 'call' actions will fail
$variables{$variable} = $retval[0];
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$retval[0]'");
} else {
$variables{$variable} = undef;
log_msg(LOG_DEBUG,
"No value received for variable '%$variable', set to undef");
}
} else {
log_msg(LOG_ERR, "Error evaluating code '$code':", $retval[0]);
}
return 3;
}
sub execute_call_action {
my($actionlist, $text, $i) = @_;
my($variable, $code, @params);
my($value, @retval);
$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_actionlist_var($value, $text); }
@retval = eval { $variables{$code}->(@params) };
if ($@) {
log_msg(LOG_ERR, "Code '%$code->()' runtime error:", $@);
} else {
if (scalar(@retval)) {
foreach $value (@retval) { if (!defined($value)) { $value = ""; } }
$value = join("\n", @retval);
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
$variables{$variable} = undef;
log_msg(LOG_DEBUG,
"No value received for variable '%$variable', set to undef");
}
}
} else {
log_msg(LOG_WARN, "Variable '%$code' is not a code reference");
}
return 4;
}
sub execute_lcall_action {
my($actionlist, $text, $i) = @_;
my($variable, $codeptr, $op, @params);
my($value, @retval);
$variable = $actionlist->[$i+1];
$codeptr = $actionlist->[$i+2];
@params = @{$actionlist->[$i+3]};
$op = $actionlist->[$i+4];
log_msg(LOG_DEBUG,
"Calling code '$codeptr' and setting variable '%$variable'");
foreach $value (@params) { substitute_actionlist_var($value, $text); }
if ($op) {
foreach $value (@params) {
$value = exists($pmatch_cache{$value})?$pmatch_cache{$value}:undef;
}
}
@retval = eval { $codeptr->(@params) };
if ($@) {
log_msg(LOG_ERR, "Code '$codeptr' runtime error:", $@);
} else {
if (scalar(@retval)) {
foreach $value (@retval) { if (!defined($value)) { $value = ""; } }
$value = join("\n", @retval);
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
} else {
$variables{$variable} = undef;
log_msg(LOG_DEBUG,
"No value received for variable '%$variable', set to undef");
}
}
return 5;
}
sub execute_rewrite_action {
my($actionlist, $text, $i) = @_;
my($count, $event, @event, $j, $buffer, $bufptr);
$count = $actionlist->[$i+1];
$event = $actionlist->[$i+2];
substitute_actionlist_var($count, $text);
substitute_actionlist_var($event, $text);
if ($count =~ /^\s*0*([0-9]+)\s*$/) {
$count = $1;
@event = split(/\n/, $event); # split returns empty list for "" or undef
$j = scalar(@event);
if (!$count) {
if (!$j) {
log_msg(LOG_WARN, "No data for rewriting input buffer");
return 3;
} else { $count = $j; }
}
if ($count > $bufsize) { $count = $bufsize; }
if ($j > $count) {
@event = @event[0 .. $count - 1];
$event = join("\n", @event);
} elsif ($j < $count) {
while ($j++ < $count) { unshift @event, ""; }
$event = join("\n", @event);
}
if ($jointbuf) {
@input_buffer[$bufpos - $count + 1 .. $bufpos] = @event;
log_msg(LOG_DEBUG, "Input buffer rewritten with '$event'");
} elsif (defined($input_sources[$bufpos])) {
# if the 'rewrite' action is not triggered by a pattern match but
# rather by system clock, the source for last input line might be
# no longer monitored (also, the elements of @input_sources list
# are set to "" at program startup)
if (exists($input_buffers{$input_sources[$bufpos]})) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
@{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event;
log_msg(LOG_DEBUG, "Input buffer of", $input_sources[$bufpos],
"rewritten with '$event'");
} else {
log_msg(LOG_WARN,
"Can't rewrite the input buffer of non-configured source",
$input_sources[$bufpos]);
}
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
@{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event;
log_msg(LOG_DEBUG,
"Input buffer of synthetic events rewritten with '$event'");
}
} else {
log_msg(LOG_WARN, "Invalid linecount '$count', can't rewrite input buffer");
}
return 3;
}
sub execute_addinput_action {
my($actionlist, $text, $i) = @_;
my($file, $fpos, $context);
my($time, $fh, $dev, $inode, $regfile);
$file = $actionlist->[$i+1];
$fpos = $actionlist->[$i+2];
$context = $actionlist->[$i+3];
substitute_actionlist_var($file, $text);
substitute_actionlist_var($fpos, $text);
substitute_actionlist_var($context, $text);
log_msg(LOG_DEBUG, "Adding dynamic input file '" . $file .
"' with context '" . $context . "' to the list of inputs");
if (exists($dyninputfiles{$file})) {
log_msg(LOG_WARN, "Dynamic input file '" . $file .
"' already exists in the list of inputs, can't add");
return 4;
}
if (exists($inputsrc{$file})) {
log_msg(LOG_WARN, "Input file '" . $file .
"' already exists in the list of inputs, can't add");
return 4;
}
if ($fpos !~ /^\s*(-|[0-9]+)\s*$/i) {
log_msg(LOG_WARN,
"Invalid file offset '$fpos' specified for input file '$file'");
return 4;
}
$fpos = $1;
# open dynamic input file
if ($fpos eq "-") {
$fpos = -1;
log_msg(LOG_DEBUG, "Opening input file '$file' and seeking EOF");
} else {
log_msg(LOG_DEBUG, "Opening input file '$file' and seeking offset '$fpos'");
}
($fh, $dev, $inode, $regfile) = open_input_file($file, $fpos);
$time = time();
$inputsrc{$file} = { "fh" => $fh,
"open" => defined($fh),
"dev" => $dev,
"inode" => $inode,
"regfile" => $regfile,
"buffer" => "",
"scriptexec" => 0,
"checktime" => 0,
"lastopen" => $time,
"lastread" => $time,
"lines" => 0,
"context" => $context };
# if the input file open failed because of the missing file, set the
# "read_from_start" flag which enforces reading from the beginning
# when the file will appear and another open will be attempted
if (!defined($fh) && $file ne "-" && ! -e $file) {
$inputsrc{$file}->{"read_from_start"} = 1;
}
# add dynamic input file to %dyninputfiles and @inputfiles global lists
$dyninputfiles{$file} = $context;
@inputfiles = sort keys %inputsrc;
# with --nojointbuf command line option, set up a separate
# input buffer for the dynamic input file
if (!$jointbuf) {
$input_buffers{$file} = {};
$input_buffers{$file}->{"Events"} = [];
$input_buffers{$file}->{"BufPos"} = 0;
$input_buffers{$file}->{"BufPos"} =
arrange_input_buffer($input_buffers{$file}->{"Events"},
$input_buffers{$file}->{"BufPos"});
}
return 4;
}
sub execute_dropinput_action {
my($actionlist, $text, $i) = @_;
my(@buf, $file, $j, $n);
$file = $actionlist->[$i+1];
substitute_actionlist_var($file, $text);
log_msg(LOG_DEBUG,
"Dropping dynamic input file '$file' from the list of inputs");
if (exists($dyninputfiles{$file})) {
# Drop dynamic input file from %dyninputfiles, %inputsrc and @inputfiles
# global lists. Note that removing relevant entry from %inputsrc will
# close the file (if it is open).
delete $dyninputfiles{$file};
delete $inputsrc{$file};
@inputfiles = sort keys %inputsrc;
# with --nojointbuf command line option, drop a separate
# input buffer of the dynamic input file
if (!$jointbuf) { delete $input_buffers{$file}; }
# remove all lines for dynamic input file from read buffer
@buf = ();
$n = scalar(@readbuffer);
for ($j = 0; $j < $n; $j += 2) {
if ($file eq $readbuffer[$j+1]) { next; }
push @buf, $readbuffer[$j], $readbuffer[$j+1];
}
@readbuffer = @buf;
} else {
log_msg(LOG_WARN, "Dynamic input file '$file' not found, can't drop");
}
return 2;
}
sub execute_sigemul_action {
my($actionlist, $text, $i) = @_;
my($signal);
$signal = $actionlist->[$i+1];
substitute_actionlist_var($signal, $text);
$signal = uc($signal);
log_msg(LOG_DEBUG, "Emulating the arrival of '$signal' signal");
if ($signal eq "HUP") {
$refresh = 1;
$sigreceived = 1;
} elsif ($signal eq "ABRT") {
$softrefresh = 1;
$sigreceived = 1;
} elsif ($signal eq "USR1") {
$dumpdata = 1;
$sigreceived = 1;
} elsif ($signal eq "USR2") {
$openlog = 1;
$sigreceived = 1;
} elsif ($signal eq "INT") {
++$debuglevelinc;
$sigreceived = 1;
} elsif ($signal eq "TERM") {
$terminate{$$} = 1;
$sigreceived = 1;
} else {
log_msg(LOG_WARN, "The arrival of '$signal' signal can't be emulated");
}
return 2;
}
sub execute_varset_action {
my($actionlist, $text, $i) = @_;
my($entry, $variable, $value);
$variable = $actionlist->[$i+1];
$entry = $actionlist->[$i+2];
substitute_actionlist_var($entry, $text);
log_msg(LOG_DEBUG,
"Checking the presence of pattern match cache entry '$entry'");
$value = (exists($pmatch_cache{$entry}))?1:0;
$variables{$variable} = $value;
log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
return 3;
}
sub execute_if_action {
my($actionlist, $text, $i) = @_;
my($variable, $ret);
$variable = $actionlist->[$i+1];
$ret = 1;
if (exists($variables{$variable}) && $variables{$variable}) {
if (scalar(@{$actionlist->[$i+2]})) {
$ret = execute_actionlist($actionlist->[$i+2], $text);
}
} else {
if (scalar(@{$actionlist->[$i+3]})) {
$ret = execute_actionlist($actionlist->[$i+3], $text);
}
}
if ($ret != 1) { return $ret; }
return 4;
}
sub execute_while_action {
my($actionlist, $text, $i) = @_;
my($variable);
$variable = $actionlist->[$i+1];
while (exists($variables{$variable}) && $variables{$variable}) {
if (execute_actionlist($actionlist->[$i+2], $text) == -1) { last; }
}
return 3;
}
sub execute_break_action { return -1; }
sub execute_continue_action { return 0; }
# Parameters: par1 - reference to a list of actions
# par2 - event description text
# Action: execute actions in a given action list.
# Return 1 if the action list was fully executed;
# return 0 if the execution was interrupted with the continue action;
# return -1 if the execution was interrupted with the break action.
sub execute_actionlist {
my($actionlist, $text) = @_;
my($i, $j, $k);
$i = 0;
$j = scalar(@{$actionlist});
while ($i < $j) {
$k = $execactionfunc[$actionlist->[$i]]->($actionlist, $text, $i);
if ($k <= 0) { return $k; }
$i += $k;
}
return 1;
}
#####################################################
# 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($ref, $alias);
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 valid_context was called recursively and action-list-on-expire
# is currently executing, the context is considered stale and return 0
if (exists($context_list{$context}->{"DeleteInProgress"})) { return 0; }
log_msg(LOG_DEBUG, "Deleting stale context '$context'");
# if the context is stale and its action-list-on-expire has not been
# executed yet, execute it now
if (scalar(@{$context_list{$context}->{"Action"}})) {
# DeleteInProgress flag indicates that the action list execution is
# in progress. The flag is used for two purposes:
# 1) if this function is called recursively for the context, the flag
# prevents the action-list-on-expire from being executed again,
# 2) the flag will temporarily disable all actions that remove either
# the context or any of its names (delete, obsolete, unalias) until
# the action-list-on-expire has completed
$context_list{$context}->{"DeleteInProgress"} = 1;
# if context name _THIS exists, the action list execution was triggered
# by the action-list-on-expire of another context that is currently
# referred by _THIS, therefore save the current value of _THIS
if (exists($context_list{"_THIS"})) { $ref = $context_list{"_THIS"}; }
else { $ref = undef; }
# set _THIS to refer to the current context
$context_list{"_THIS"} = $context_list{$context};
# execute the action-list-on-expire
execute_actionlist($context_list{$context}->{"Action"},
$context_list{$context}->{"Desc"});
# if context name _THIS was referring to another context previously,
# restore the previous value, otherwise delete _THIS
if (defined($ref)) { $context_list{"_THIS"} = $ref; }
else { delete $context_list{"_THIS"}; }
}
# remove all names of the context from the list of contexts
foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) {
delete $context_list{$alias};
log_msg(LOG_DEBUG, "Stale context '$alias' deleted");
}
}
return 0;
}
# Parameters: par1 - reference to a context expression
# Action: calculate the truth value of the context expression par1;
# return 1 if it is TRUE, 0 if it is FALSE, and undef if
# the context expression is empty.
sub tval_context_expr {
my($ref) = $_[0];
my($i, $j, $left, @right);
my($evalresult, $evalok, $retval);
my($code, $func, $param, @params);
$i = 0;
$j = scalar(@{$ref});
$left = undef;
@right = ();
while ($i < $j) {
if ($ref->[$i] == OPERAND) {
if (defined($left)) {
push @right, OPERAND, $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 && tval_context_expr(\@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 || tval_context_expr(\@right);
@right = ();
++$i;
}
elsif ($ref->[$i] == EXPRESSION) {
if (defined($left)) {
push @right, EXPRESSION, $ref->[$i+1];
} else {
$left = tval_context_expr($ref->[$i+1]);
}
$i += 2;
}
elsif ($ref->[$i] == ECODE) {
if (defined($left)) {
push @right, ECODE, $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, $ref->[$i+1], $ref->[$i+2];
} else {
# parameters for $func->() are copied into a new list @params, since
# tval_context_expr() 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). Thus, passing
# original parameter list to the end user would allow the user to
# modify the original context definition. Furthermore, varset
# parameters need to be replaced with corresponding references.
@params = @{$ref->[$i+1]};
$func = $ref->[$i+2];
$retval = eval { $func->(@params) };
# 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] == CCODE2) {
if (defined($left)) {
push @right, CCODE2, $ref->[$i+1], $ref->[$i+2];
} else {
# parameters for $func->() are copied into a new list @params, since
# tval_context_expr() 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). Thus, passing
# original parameter list to the end user would allow the user to
# modify the original context definition. Furthermore, varset
# parameters need to be replaced with corresponding references.
@params = @{$ref->[$i+1]};
$func = $ref->[$i+2];
foreach $param (@params) {
$param = exists($pmatch_cache{$param})?$pmatch_cache{$param}:undef;
}
$retval = eval { $func->(@params) };
# 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] == VARSET) {
if (defined($left)) {
push @right, VARSET, $ref->[$i+1];
} else {
$left = exists($pmatch_cache{$ref->[$i+1]})?1:0;
}
$i += 2;
}
}
return $left;
}
# Parameters: par1 - number of lines the pattern matches (unused)
# par2 - pattern (truth value)
# par3 - match variable hash
# Action: if par2 is TRUE, set par3 to an empty hash and return 1,
# otherwise return 0
sub match_tvalue {
my(undef, $tvalue, $subst_ref) = @_;
if ($tvalue) { %{$subst_ref} = (); return 1; }
return 0;
}
# Parameters: par1 - number of lines the pattern matches (unused)
# par2 - pattern (cached match)
# par3 - match variable hash
# Action: if par2 exists, set par3 to the match variable hash pointed by
# par2 and return 1, otherwise return 0
sub match_cached {
my(undef, $match, $subst_ref) = @_;
if (exists($pmatch_cache{$match})) {
%{$subst_ref} = %{$pmatch_cache{$match}};
return 1;
}
return 0;
}
# Parameters: par1 - number of lines the pattern matches (unused)
# par2 - pattern (cached match)
# par3 - match variable hash
# Action: if par2 does not exist, set par3 to empty hash and return 1,
# otherwise return 0
sub match_ncached {
my(undef, $match, $subst_ref) = @_;
if (!exists($pmatch_cache{$match})) { %{$subst_ref} = (); return 1; }
return 0;
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (string type)
# par3 - match variable hash
# Action: take par1 last lines from input buffer and concatenate them to
# form a single string. If par2 is a substring in the formed
# string (both par1 and par2 can contain newlines), set par3 to
# an empty hash and return 1, otherwise return 0.
sub match_substr {
my($linecount, $substr, $subst_ref) = @_;
my($line, $buffer, $bufptr);
if ($bufsize == 1) {
$line = $input_buffer[0];
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
}
if (index($line, $substr) != -1) {
%{$subst_ref} = ();
return 1;
}
return 0;
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (string type)
# par3 - match variable hash (will be emptied)
# Action: take par1 last lines from input buffer and concatenate them to
# form a single string. If par2 is not a substring in the formed
# string (both par1 and par2 can contain newlines), set par3 to
# an empty hash and return 1, otherwise return 0.
sub match_nsubstr {
my($linecount, $substr, $subst_ref) = @_;
my($line, $buffer, $bufptr);
if ($bufsize == 1) {
$line = $input_buffer[0];
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
}
if (index($line, $substr) == -1) {
%{$subst_ref} = ();
return 1;
}
return 0;
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (regular expression type)
# par3 - match variable hash
# par4 - variable map hash
# 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 ()-operators, save
# the substring matches to a hash par3. Additional variables are
# then created in par3 according to map in par4. If specified with
# the map par4, match variable values are cached. If the formed
# string matched a regular expression, return 1, otherwise return 0
sub match_regexp {
my($linecount, $regexp, $subst_ref, $varmap_ref) = @_;
my($line, $buffer, $bufptr, @matches);
if ($bufsize == 1) {
$line = $input_buffer[0];
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
}
if (@matches = ($line =~ /$regexp/)) {
# since a number of variables are only needed when there is a match,
# declare them in relevant code block only for performance reasons
my($match, $var, $i, $j, @celem);
# overwrite the previous content of the match variable hash with named
# substring matches from the regular expression
%{$subst_ref} = %+;
# add the $<number> match variables to the variable hash
$i = 1;
foreach $match (@matches) { $subst_ref->{$i++} = $match; }
# create the $0 variable
$subst_ref->{"0"} = $line;
# create the $+{_inputsrc} variable
if ($bufsize == 1) {
$subst_ref->{"_inputsrc"} =
defined($input_sources[0])?$input_sources[0]:"synthetic";
} elsif ($jointbuf) {
$subst_ref->{"_inputsrc"} = join(" ", map(defined($_)?$_:"synthetic",
@input_sources[$bufpos - $linecount + 1 .. $bufpos]));
} else {
$subst_ref->{"_inputsrc"} =
defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic";
}
# create the $+{_intcontext} variable
$subst_ref->{"_intcontext"} = $intcontextname;
# add the $<name> match variables to the variable hash,
# and add match variable values to pattern match cache
if (scalar(%{$varmap_ref})) {
$j = scalar(@matches);
@celem = ();
while (($var, $i) = each %{$varmap_ref}) {
if (!defined($i)) { push @celem, $var; next; }
$subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef;
}
foreach $var (@celem) { $pmatch_cache{$var} = { %{$subst_ref} }; }
}
return 1;
}
return 0;
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (regular expression type)
# par3 - match variable hash
# Action: take par1 last lines from input buffer and concatenate them to
# form a single string. Match the formed string with regular
# expression par2. If the formed string did not match a regular
# expression, return 1, otherwise return 0
sub match_nregexp {
my($linecount, $regexp, $subst_ref) = @_;
my($line, $buffer, $bufptr, $source);
if ($bufsize == 1) {
$line = $input_buffer[0];
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
}
if ($line !~ /$regexp/) {
# erase the previous content of the match variable hash, and
# create the $0, $+{_inputsrc} and $+{_intcontext} variables
if ($bufsize == 1) {
$source = defined($input_sources[0])?$input_sources[0]:"synthetic";
} elsif ($jointbuf) {
$source = join(" ", map(defined($_)?$_:"synthetic",
@input_sources[$bufpos - $linecount + 1 .. $bufpos]));
} else {
$source =
defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic";
}
%{$subst_ref} = ( "0" => $line,
"_inputsrc" => $source,
"_intcontext" => $intcontextname );
return 1;
}
return 0;
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (perl function pointer)
# par3 - match variable hash
# par4 - variable map hash
# 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 to hash par3 (and cache if specified
# by map par4). If the function returned an empty list or returned
# a single value FALSE, return 0, otherwise return 1
sub match_perlfunc {
my($linecount, $codeptr, $subst_ref, $varmap_ref) = @_;
my(@lines, @sources, $buffer, $bufptr);
my(@matches, $size);
if ($bufsize == 1) {
$lines[0] = $input_buffer[0];
$sources[0] = $input_sources[0];
} elsif ($jointbuf) {
@lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos];
@sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos];
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
@lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
$sources[0] = $input_sources[$bufpos];
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
@lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
$sources[0] = undef;
}
# call the function and save its return values
@matches = eval { $codeptr->(@lines, @sources) };
# in the case of a function runtime error there is no match
if ($@) {
log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@);
return 0;
}
# if the function returned no values or a single value which evaluates
# FALSE in boolean context, there is no match, and return 0 immediately
$size = scalar(@matches);
if ($size == 0 || ($size == 1 && !$matches[0])) { return 0; }
# if the function produced a match, set match variables
else {
# since a number of variables are only needed when there is a match,
# declare them in relevant code block only for performance reasons
my($line, $source, $match, $var, $i, $j, @celem);
# initialize the match variable hash
%{$subst_ref} = ();
# if the function returned a hash reference, create named match
# variables from key=value pairs in the hash; otherwise add
# function return values to the variable hash as numeric variables
if ($size == 1 && ref($matches[0]) eq "HASH") {
while ($var = each %{$matches[0]}) {
$subst_ref->{$var} = $matches[0]->{$var};
}
} else {
$i = 1;
foreach $match (@matches) { $subst_ref->{$i++} = $match; }
}
# create the $0, $+{_inputsrc} and $+{_intcontext} variables
if ($bufsize == 1) {
$line = $input_buffer[0];
$source = defined($input_sources[0])?$input_sources[0]:"synthetic";
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
$source = join(" ", map(defined($_)?$_:"synthetic",
@input_sources[$bufpos - $linecount + 1 .. $bufpos]));
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
$source = $input_sources[$bufpos];
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
$source = "synthetic";
}
$subst_ref->{"0"} = $line;
$subst_ref->{"_inputsrc"} = $source;
$subst_ref->{"_intcontext"} = $intcontextname;
# add the $<name> match variables to the variable hash,
# and add match variable values to pattern match cache
if (scalar(%{$varmap_ref})) {
$j = scalar(@matches);
@celem = ();
while (($var, $i) = each %{$varmap_ref}) {
if (!defined($i)) { push @celem, $var; next; }
$subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef;
}
foreach $var (@celem) { $pmatch_cache{$var} = { %{$subst_ref} }; }
}
return 1;
}
}
# Parameters: par1 - number of lines the pattern matches
# par2 - pattern (perl function pointer)
# par3 - match variable hash
# Action: take par1 last lines from input buffer with corresponding source
# names, and pass them to the perl function par2->().
# If the function returned an empty list or returned
# a single value FALSE, return 1, otherwise return 0
sub match_nperlfunc {
my($linecount, $codeptr, $subst_ref) = @_;
my(@lines, @sources, $buffer, $bufptr);
my(@matches, $size, $line, $source);
if ($bufsize == 1) {
$lines[0] = $input_buffer[0];
$sources[0] = $input_sources[0];
} elsif ($jointbuf) {
@lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos];
@sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos];
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
@lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
$sources[0] = $input_sources[$bufpos];
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
@lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
$sources[0] = undef;
}
# call the function and save its return values
@matches = eval { $codeptr->(@lines, @sources) };
# in the case of a function runtime error there is no match
if ($@) {
log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@);
return 0;
}
# if the function returned several values or a single value which evaluates
# TRUE in boolean context, there is no match, and return 0 immediately
$size = scalar(@matches);
if ($size > 1 || ($size == 1 && $matches[0])) { return 0; }
# erase the previous content of the match variable hash, and
# create the $0, $+{_inputsrc} and $+{_intcontext} variables
if ($bufsize == 1) {
$line = $input_buffer[0];
$source = defined($input_sources[0])?$input_sources[0]:"synthetic";
} elsif ($jointbuf) {
$line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
$source = join(" ", map(defined($_)?$_:"synthetic",
@input_sources[$bufpos - $linecount + 1 .. $bufpos]));
} elsif (defined($input_sources[$bufpos])) {
$buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
$bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
$source = $input_sources[$bufpos];
} else {
$buffer = $event_buffer{"Events"};
$bufptr = $event_buffer{"BufPos"};
$line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
$source = "synthetic";
}
%{$subst_ref} = ( "0" => $line,
"_inputsrc" => $source,
"_intcontext" => $intcontextname );
return 1;
}
# Parameters: par1 - reference to a source action list
# par2 - reference to a destination action list
# par3 - pointer into the source and destination list
# Action: action from list par1 will be copied to par2; the function
# will return an offset for advancing the pointer par3
sub copy_one_elem_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i];
return 1;
}
sub copy_two_elem_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i];
return 2;
}
sub copy_three_elem_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i];
return 3;
}
sub copy_four_elem_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
$src_ref->[$i++], $src_ref->[$i];
return 4;
}
sub copy_five_elem_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
$src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i];
return 5;
}
sub copy_cmdexec_spawnexec_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], [ @{$src_ref->[$i]} ];
return 2;
}
sub copy_cspawnexec_pipeexec_reportexec_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [ @{$src_ref->[$i]} ];
return 3;
}
sub copy_create_set_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++], [];
copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
return 4;
}
sub copy_call_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
$src_ref->[$i++], [ @{$src_ref->[$i]} ];
return 4;
}
sub copy_lcall_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++],
[ @{$src_ref->[$i++]} ], $src_ref->[$i];
return 5;
}
sub copy_if_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [], [];
copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
++$i;
copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
return 4;
}
sub copy_while_action {
my($src_ref, $dest_ref, $i) = @_;
push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [];
copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
return 3;
}
# 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, $dest_ref) = @_;
my($i, $j);
@{$dest_ref} = ();
$i = 0;
$j = scalar(@{$src_ref});
while ($i < $j) {
$i += $actioncopyfunc[$src_ref->[$i]]->($src_ref, $dest_ref, $i);
}
}
# 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, $dest_ref) = @_;
my($i, $j);
@{$dest_ref} = ();
$i = 0;
$j = scalar(@{$src_ref});
while ($i < $j) {
if ($src_ref->[$i] == OPERAND) {
push @{$dest_ref}, OPERAND, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == EXPRESSION) {
push @{$dest_ref}, EXPRESSION, [];
copy_context($src_ref->[$i+1], $dest_ref->[$i+1]);
$i += 2;
}
elsif ($src_ref->[$i] == ECODE) {
push @{$dest_ref}, ECODE, $src_ref->[$i+1];
$i += 2;
}
elsif ($src_ref->[$i] == CCODE) {
push @{$dest_ref}, CCODE, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == CCODE2) {
push @{$dest_ref}, CCODE2, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2];
$i += 3;
}
elsif ($src_ref->[$i] == VARSET) {
push @{$dest_ref}, VARSET, $src_ref->[$i+1];
$i += 2;
}
else {
push @{$dest_ref}, $src_ref->[$i];
++$i;
}
}
}
# Parameters: par1 - reference to the hash of match variables
# par2, par3, .. - strings that will go through
# the substitution 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 corresponding
# values from hash par1. If the token symbol is followed by
# another token symbol, these two symbols will be replaced by
# a single token (e.g., $$ -> $).
sub subst_string {
my($subst_ref) = shift @_;
my($token) = pop @_;
my($token2, $msg);
$token2 = quotemeta($token);
# variable names in variable map definitions must begin with a letter, but
# since named match variables defined in Perl regular expressions can begin
# both with a letter and underscore, both cases are handled below
foreach $msg (@_) {
if (index($msg, $token) == -1) { next; }
elsif (index($msg, "$token:{") == -1) {
$msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}|
\+\{([[:alpha:]_][\w!]*|[0-9]+)\})/
!defined($+)?$token:(defined($subst_ref->{$+})?$subst_ref->{$+}:"")/egx;
} else {
# calling defined($pmatch_cache{$4}->{$+}) will create $pmatch_cache{$4}
# if it doesn't exist, thus exists($pmatch_cache{$4}) is called first
$msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}|
\+\{([[:alpha:]_][\w!]*|[0-9]+)\}|
:\{([[:alpha:]]\w*):([[:alpha:]_][\w!]*|[0-9]+)\})/
!defined($+)?$token:
(!defined($4)?(defined($subst_ref->{$+})?$subst_ref->{$+}:""):
((exists($pmatch_cache{$4}) && defined($pmatch_cache{$4}->{$+}))?
$pmatch_cache{$4}->{$+}:""))/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};
while ($subst = each %subst_modified) {
if (defined($subst_modified{$subst})) {
$subst_modified{$subst} = quotemeta($subst_modified{$subst});
}
}
subst_string(\%subst_modified, @_, $token);
}
# Parameters: par1 - reference to the array of replacements
# par2 - reference to a context expression
# par3 - token that special variables start with
# Action: Context expression 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, $ref, $token) = @_;
my($i, $j);
$i = 0;
$j = scalar(@{$ref});
while ($i < $j) {
if ($ref->[$i] == OPERAND || $ref->[$i] == VARSET
|| $ref->[$i] == ECODE) {
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] == CCODE || $ref->[$i] == CCODE2) {
subst_string($subst_ref, @{$ref->[$i+1]}, $token);
$i += 3;
}
else { ++$i; }
}
}
# Parameters: par1 - reference to the array of replacements
# par2 - reference to the array of replacements (originals)
# par3 - reference to action list
# par4 - token that special variables start with
# par5 - pointer into the action list
# Action: action from list par3 will be searched for special variables
# (like $1, $2, ..) that will be replaced with 1st, 2nd, ..
# element from array par1 or par2; the function will return an offset
# for advancing the pointer par5
sub subst_none_break_continue { return 1; }
sub subst_free { return 2; }
sub subst_two_elem_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
return 2;
}
sub subst_three_elem_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
subst_string($subst_ref, $actionlist->[$i+2], $token);
return 3;
}
sub subst_four_elem_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
subst_string($subst_ref, $actionlist->[$i+2], $token);
subst_string($subst_ref, $actionlist->[$i+3], $token);
return 4;
}
sub subst_cmdexec_spawnexec_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, @{$actionlist->[$i+1]}, $token);
return 2;
}
sub subst_cspawnexec_pipeexec_reportexec_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
subst_string($subst_ref, @{$actionlist->[$i+2]}, $token);
return 3;
}
sub subst_create_set_action {
my($subst_ref, $subst_orig_ref, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
subst_string($subst_ref, $actionlist->[$i+2], $token);
subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token);
return 4;
}
sub subst_copy_empty_etc_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
return 3;
}
sub subst_event_assign_etc_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+2], $token);
return 3;
}
sub subst_reset_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+3], $token);
return 4;
}
sub subst_getwpos_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+4], $token);
return 5;
}
sub subst_setwpos_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, $actionlist->[$i+1], $token);
subst_string($subst_ref, $actionlist->[$i+4], $token);
return 5;
}
sub subst_call_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, @{$actionlist->[$i+3]}, $token);
return 4;
}
sub subst_lcall_action {
my($subst_ref, undef, $actionlist, $token, $i) = @_;
subst_string($subst_ref, @{$actionlist->[$i+3]}, $token);
return 5;
}
sub subst_if_action {
my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_;
subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token);
subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token);
return 4;
}
sub subst_while_action {
my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_;
subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token);
return 3;
}
# 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, $actionlist, $token) = @_;
my($subst, %subst_modified);
my($i, $j);
# mask %-signs in substitutions, in order to prevent incorrect
# %<alnum>-variable interpretations
%subst_modified = %{$subst_ref};
while ($subst = each %subst_modified) {
if (defined($subst_modified{$subst})) {
$subst_modified{$subst} =~ s/%/%%/g;
}
}
# process the action list
$i = 0;
$j = scalar(@{$actionlist});
while ($i < $j) {
$i += $actionsubstfunc[$actionlist->[$i]]->(\%subst_modified,
$subst_ref,
$actionlist,
$token, $i);
}
}
# Parameters: par1 - reference to an operation from list %corr_list
# par2 - timestamp
# par3 - flag (optional)
# Action: search the list of event occurrence times of the SingleWithThreshold
# or SingleWith2Thresholds operation which is pointed by par1;
# list elements which are older than par2 will be removed.
# If flag par3 is set, the beginning of the event correlation
# window for operation par1 will be set to par2; otherwise it will
# be set to the earliest remaining occurrence time in the list.
sub update_times_swt {
my($oper, $time, $flag) = @_;
my($tlist);
$tlist = $oper->{"Times"};
while (scalar(@{$tlist})) {
if ($tlist->[0] >= $time) { last; }
shift @{$tlist};
}
if (!defined($flag) && scalar(@{$tlist})) {
$oper->{"Time"} = $tlist->[0];
} else {
$oper->{"Time"} = $time;
}
}
# Parameters: par1 - reference to an operation from list %corr_list
# par2 - timestamp
# par3 - flag (optional)
# Action: search the list of event occurrence times of the EventGroup
# operation which is pointed by par1; list elements which are older
# than par2 will be removed.
# If flag par3 is set, the beginning of the event correlation
# window for operation par1 will be set to par2; otherwise it will
# be set to the earliest remaining occurrence time in the list.
sub update_times_eg {
my($oper, $time, $flag) = @_;
my($tlist, $i);
$tlist = $oper->{"AllTimes"};
while (scalar(@{$tlist})) {
if ($tlist->[0]->[0] >= $time) { last; }
$i = $tlist->[0]->[1];
shift @{$oper->{"TimesList"}->[$i]};
shift @{$tlist};
}
if (!defined($flag) && scalar(@{$tlist})) {
$oper->{"Time"} = $tlist->[0]->[0];
} else {
$oper->{"Time"} = $time;
}
}
# Parameters: par1 - event group matching pattern
# par2 - reference to the list of observed events
# Action: build the event group string from the list referenced by par2,
# and match this event group string with event group pattern par1;
# return 1 if match was found, otherwise return 0.
# In the case of PerlFunc and NPerlFunc patterns, the perl function
# referenced by par1 takes three parameters: event group string,
# reference to the list of tokens, and reference to the list of
# event occurrence times
sub match_eventgroup_substr {
my($substr, $ref) = @_;
my($egrpstring);
# build the event group string and match it with the pattern
$egrpstring = join(" ", map { $_->[2] } @{$ref});
if (index($egrpstring, $substr) != -1) { return 1; }
return 0;
}
sub match_eventgroup_nsubstr {
my($substr, $ref) = @_;
my($egrpstring);
# build the event group string and match it with the pattern
$egrpstring = join(" ", map { $_->[2] } @{$ref});
if (index($egrpstring, $substr) == -1) { return 1; }
return 0;
}
sub match_eventgroup_regexp {
my($regexp, $ref) = @_;
my($egrpstring);
# build the event group string and match it with the pattern
$egrpstring = join(" ", map { $_->[2] } @{$ref});
if ($egrpstring =~ /$regexp/) { return 1; }
return 0;
}
sub match_eventgroup_nregexp {
my($regexp, $ref) = @_;
my($egrpstring);
# build the event group string and match it with the pattern
$egrpstring = join(" ", map { $_->[2] } @{$ref});
if ($egrpstring !~ /$regexp/) { return 1; }
return 0;
}
sub match_eventgroup_perlfunc {
my($codeptr, $ref) = @_;
my(@timelist, @tokenlist, $egrpstring, $elem, $retval);
# build the event group string and list parameters for the function
foreach $elem (@{$ref}) {
push @timelist, $elem->[0];
push @tokenlist, $elem->[2];
}
$egrpstring = join(" ", @tokenlist);
# call the function and save its return value;
# in the case of a function runtime error there is no match
$retval = eval { $codeptr->($egrpstring, \@tokenlist, \@timelist) };
if ($@) {
log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@);
return 0;
}
# if the function returned a value which evaluates true in boolean
# context (neither undef, nor "", nor 0), return 1, otherwise return 0
if ($retval) { return 1; }
return 0;
}
sub match_eventgroup_nperlfunc {
my($codeptr, $ref) = @_;
my(@timelist, @tokenlist, $egrpstring, $elem, $retval);
# build the event group string and list parameters for the function
foreach $elem (@{$ref}) {
push @timelist, $elem->[0];
push @tokenlist, $elem->[2];
}
$egrpstring = join(" ", @tokenlist);
# call the function and save its return value;
# in the case of a function runtime error there is no match
$retval = eval { $codeptr->($egrpstring, \@tokenlist, \@timelist) };
if ($@) {
log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@);
return 0;
}
# if the function returned a value which evaluates false in boolean
# context (undef, "", or 0), return 1, otherwise return 0
if (!$retval) { return 1; }
return 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 - reference to the rule definition
# par2 - reference to the hash of match values
# Action: process the Single rule after a match has been found
sub process_single_rule {
my($rule, $subst) = @_;
my($desc, $action);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
subst_string($subst, $desc, '$');
} else { $action = $rule->{"Action"}; }
execute_actionlist($action, $desc);
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# Action: process the SingleWithScript rule after a match has been found
sub process_singlewithscript_rule {
my($rule, $subst) = @_;
my(@script, $script, $shell, $desc, $pid);
my($action, $action2);
$desc = $rule->{"Desc"};
# check if the command line provided with the 'script' field has to be
# executed without shell interpretation, and if yes, copy the command
# line arguments into local array @script
if (ref($rule->{"Script"}) eq "ARRAY") {
@script = @{$rule->{"Script"}};
$shell = 0;
} else {
$script = $rule->{"Script"};
$shell = 1;
}
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
if (exists($rule->{"ActVolat2"})) {
$action2 = [];
copy_actionlist($rule->{"Action2"}, $action2);
subst_actionlist($subst, $action2, '$');
} else { $action2 = $rule->{"Action2"}; }
if ($shell) {
subst_string($subst, $desc, $script, '$');
} else {
subst_string($subst, $desc, @script, '$');
}
} else {
$action = $rule->{"Action"};
$action2 = $rule->{"Action2"};
}
# if the command line provided with the 'script' field has to be
# executed without shell interpretation, pass a reference to the
# array @script with command line arguments to pipe_cmd() function
if ($shell) {
$pid = pipe_cmd($script, \%context_list);
} else {
$pid = pipe_cmd(\@script, \%context_list);
}
if (defined($pid)) {
$children{$pid}->{"Desc"} = $desc;
$children{$pid}->{"Action"} = $action;
$children{$pid}->{"Action2"} = $action2;
}
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# Action: process the SingleWithSuppress rule after a match has been found
sub process_singlewithsuppress_rule {
my($rule, $subst, $conffile) = @_;
my($desc, $key, $time, $action);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"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"} > $corr_list{$key}->{"Window"}) {
if (scalar(%{$subst}) && exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"Desc" => $desc,
"Action" => $action };
execute_actionlist($action, $desc);
}
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# Action: process the Pair rule after a match has been found
sub process_pair_rule {
my($rule, $subst, $conffile) = @_;
my($desc, $key, $time, $temppat, $pattern2, $desc2);
my($action, $action2, $context2, $sub, $act2copied);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"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}) || ($corr_list{$key}->{"Window"} &&
$time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"})) {
$pattern2 = $rule->{"Pattern2"};
$desc2 = $rule->{"Desc2"};
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
if (exists($rule->{"ActVolat2"})) {
$action2 = [];
copy_actionlist($rule->{"Action2"}, $action2);
$act2copied = 1;
} else { $action2 = $rule->{"Action2"}; }
if (exists($rule->{"ContVolat2"})) {
$context2 = [];
copy_context($rule->{"Context2"}, $context2);
} else { $context2 = $rule->{"Context2"}; }
if ($rule->{"PatType2"} == REGEXP ||
$rule->{"PatType2"} == NREGEXP) {
if (exists($rule->{"Pat2NotCompiled"})) {
subst_regexp($subst, $pattern2, '$');
$temppat = $pattern2;
$pattern2 = eval { qr/$pattern2/ };
if ($@) {
log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for Pair rule:", $@);
log_msg(LOG_ERR, "Can't start Pair event correlation operation with the key '$key'");
return;
}
}
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
while ($sub = each %{$subst}) {
if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; }
}
subst_string($subst, $desc2, '%');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '%');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '%');
}
} elsif ($rule->{"PatType2"} == PERLFUNC ||
$rule->{"PatType2"} == NPERLFUNC ||
$rule->{"PatType2"} == CACHED) {
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
while ($sub = each %{$subst}) {
if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; }
}
subst_string($subst, $desc2, '%');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '%');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '%');
}
} elsif ($rule->{"PatType2"} == SUBSTR ||
$rule->{"PatType2"} == NSUBSTR) {
subst_string($subst, $pattern2, $desc2, '$');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '$');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '$');
}
} elsif ($rule->{"PatType2"} == NCACHED ||
$rule->{"PatType2"} == TVALUE) {
subst_string($subst, $desc2, '$');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '$');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '$');
}
}
} else {
$action = $rule->{"Action"};
$action2 = $rule->{"Action2"};
$context2 = $rule->{"Context2"};
}
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"Desc" => $desc,
"Action" => $action,
"Pattern2" => $pattern2,
"Context2" => $context2,
"Desc2" => $desc2,
"Action2" => $action2 };
if (defined($act2copied)) { $corr_list{$key}->{"Act2Copied"} = 1; }
$rule->{"Operations"}->{$key} = $corr_list{$key};
execute_actionlist($action, $desc);
}
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# Action: process the PairWithWindow rule after a match has been found
sub process_pairwithwindow_rule {
my($rule, $subst, $conffile) = @_;
my($desc, $key, $time, $temppat, $pattern2, $desc2);
my($action, $action2, $context2, $sub, $act2copied);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"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"} > $corr_list{$key}->{"Window"}) {
execute_actionlist($corr_list{$key}->{"Action"}, $desc);
delete $corr_list{$key};
delete $rule->{"Operations"}->{$key};
}
# if there is no event correlation operation for the key,
# start the new operation
if (!exists($corr_list{$key})) {
$pattern2 = $rule->{"Pattern2"};
$desc2 = $rule->{"Desc2"};
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
if (exists($rule->{"ActVolat2"})) {
$action2 = [];
copy_actionlist($rule->{"Action2"}, $action2);
$act2copied = 1;
} else { $action2 = $rule->{"Action2"}; }
if (exists($rule->{"ContVolat2"})) {
$context2 = [];
copy_context($rule->{"Context2"}, $context2);
} else { $context2 = $rule->{"Context2"}; }
if ($rule->{"PatType2"} == REGEXP ||
$rule->{"PatType2"} == NREGEXP) {
if (exists($rule->{"Pat2NotCompiled"})) {
subst_regexp($subst, $pattern2, '$');
$temppat = $pattern2;
$pattern2 = eval { qr/$pattern2/ };
if ($@) {
log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for PairWithWindow rule:", $@);
log_msg(LOG_ERR, "Can't start PairWithWindow event correlation operation with the key '$key'");
return;
}
}
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
while ($sub = each %{$subst}) {
if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; }
}
subst_string($subst, $desc2, '%');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '%');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '%');
}
} elsif ($rule->{"PatType2"} == PERLFUNC ||
$rule->{"PatType2"} == NPERLFUNC ||
$rule->{"PatType2"} == CACHED) {
# mask all $-symbols in substitutions, in order to prevent
# false interpretations when the second pattern matches
while ($sub = each %{$subst}) {
if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; }
}
subst_string($subst, $desc2, '%');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '%');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '%');
}
} elsif ($rule->{"PatType2"} == SUBSTR ||
$rule->{"PatType2"} == NSUBSTR) {
subst_string($subst, $pattern2, $desc2, '$');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '$');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '$');
}
} elsif ($rule->{"PatType2"} == NCACHED ||
$rule->{"PatType2"} == TVALUE) {
subst_string($subst, $desc2, '$');
if (exists($rule->{"ActVolat2"})) {
subst_actionlist($subst, $action2, '$');
}
if (exists($rule->{"ContVolat2"})) {
subst_context($subst, $context2, '$');
}
}
} else {
$action = $rule->{"Action"};
$action2 = $rule->{"Action2"};
$context2 = $rule->{"Context2"};
}
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"Desc" => $desc,
"Action" => $action,
"Pattern2" => $pattern2,
"Context2" => $context2,
"Desc2" => $desc2,
"Action2" => $action2 };
if (defined($act2copied)) { $corr_list{$key}->{"Act2Copied"} = 1; }
$rule->{"Operations"}->{$key} = $corr_list{$key};
}
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# Action: process the SingleWithThreshold rule after a match has been found
sub process_singlewiththreshold_rule {
my($rule, $subst, $conffile) = @_;
my($desc, $key, $time, $oper, $action, $action2);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"ID"}, $desc);
$time = time();
# if there exists event correlation operation for the key and its window
# has expired, slide the window forward or terminate the operation
if (exists($corr_list{$key}) &&
$time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) {
$oper = $corr_list{$key};
if (!exists($oper->{"SuppressMode"})) {
# if the operation is not in event suppressing mode, slide the window
# forward; if no events remain in the window, terminate the operation
update_times_swt($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
# if the operation is in event suppressing mode, terminate it
execute_actionlist($oper->{"Action2"}, $desc);
delete $corr_list{$key};
}
}
# if there was no event correlation operation for the key when this
# function was called (or the operation was terminated previously
# within this function), start the new operation
if (!exists($corr_list{$key})) {
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
if (exists($rule->{"ActVolat2"})) {
$action2 = [];
copy_actionlist($rule->{"Action2"}, $action2);
subst_actionlist($subst, $action2, '$');
} else { $action2 = $rule->{"Action2"}; }
} else {
$action = $rule->{"Action"};
$action2 = $rule->{"Action2"};
}
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"Times" => [],
"Desc" => $desc,
"Action" => $action,
"Action2" => $action2 };
}
$oper = $corr_list{$key};
# if the operation is in event suppressing mode, return
if (exists($oper->{"SuppressMode"})) { return; }
# record data about the current event into occurrence time list
push @{$oper->{"Times"}}, $time;
# return if the number of events in the list is below threshold
if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"}) { return; }
# if the threshold condition is met, go to suppressing mode
$oper->{"SuppressMode"} = 1;
# execute the rule action (if setwpos action gets executed for
# the operation, it will appear in suppressing mode)
execute_actionlist($oper->{"Action"}, $desc);
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# Action: process the SingleWith2Thresholds rule after a match has been found
sub process_singlewith2thresholds_rule {
my($rule, $subst, $conffile) = @_;
my($desc, $key, $time, $oper, $desc2, $action, $action2);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"ID"}, $desc);
$time = time();
# if there exists event correlation operation for the key and its window
# has expired, slide the window forward or terminate the operation
if (exists($corr_list{$key}) &&
$time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) {
$oper = $corr_list{$key};
if (!exists($oper->{"2ndPass"})) {
# if the operation is in rising threshold mode, slide the window
# forward; if no events remain in the window, terminate the operation
update_times_swt($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
# if the operation is in falling threshold mode, terminate it
execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
delete $corr_list{$key};
}
}
# if there was no event correlation operation for the key when this
# function was called (or the operation was terminated previously
# within this function), start the new operation
if (!exists($corr_list{$key})) {
$desc2 = $rule->{"Desc2"};
if (scalar(%{$subst})) {
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
if (exists($rule->{"ActVolat2"})) {
$action2 = [];
copy_actionlist($rule->{"Action2"}, $action2);
subst_actionlist($subst, $action2, '$');
} else { $action2 = $rule->{"Action2"}; }
subst_string($subst, $desc2, '$');
} else {
$action = $rule->{"Action"};
$action2 = $rule->{"Action2"};
}
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"Times" => [],
"Desc" => $desc,
"Action" => $action,
"Desc2" => $desc2,
"Action2" => $action2 };
}
$oper = $corr_list{$key};
# record data about the current event into occurrence time list
push @{$oper->{"Times"}}, $time;
if (!exists($oper->{"2ndPass"})) {
# the operation is in rising threshold mode:
# return if the number of events in the list is below threshold
if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"}) { return; }
# if the threshold condition is met, go to falling threshold mode
$oper->{"2ndPass"} = 1;
$oper->{"Time"} = $time;
$oper->{"Window"} = $rule->{"Window2"};
@{$oper->{"Times"}} = ();
# execute the rule action (if setwpos action gets executed for
# the operation, it will appear in falling threshold mode)
execute_actionlist($oper->{"Action"}, $desc);
} else {
# the operation is in falling threshold mode:
# return if the number of events in the list is not greater than threshold
if (scalar(@{$oper->{"Times"}}) <= $rule->{"Threshold2"}) { return; }
# if the threshold condition is met, remove the first occurrence time
# from the time list, and move the window to the second occurrence time
# time (if the list became empty after first element was removed , i.e.
# the threshold is 0, move the window to current time)
shift @{$oper->{"Times"}};
if (scalar(@{$oper->{"Times"}})) {
$oper->{"Time"} = $oper->{"Times"}->[0];
} else {
$oper->{"Time"} = $time;
}
}
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# par4 - the number of the pattern that has produced the match
# Action: process the EventGroup rule after a match has been found
sub process_eventgroup_rule {
my($rule, $subst, $conffile, $index) = @_;
my($desc, $key, $time, $oper, $i);
my($initaction, $slideaction, $endaction, $countaction, $action);
$desc = $rule->{"Desc"};
if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); }
$key = gen_key($conffile, $rule->{"ID"}, $desc);
$time = time();
# if there exists event correlation operation for the key and its window
# has expired, slide the window forward or terminate the operation
if (exists($corr_list{$key}) &&
$time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) {
$oper = $corr_list{$key};
if (!exists($oper->{"SuppressMode"})) {
# if the operation is not in event suppressing mode, slide the window
# forward; if no events remain in the window, terminate the operation
update_times_eg($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"AllTimes"}})) {
$oper->{"DeleteInProgress"} = 1;
execute_actionlist($oper->{"EndAction"}, $desc);
delete $corr_list{$key};
} else {
execute_actionlist($oper->{"SlideAction"}, $desc);
}
} else {
# if the operation is in event suppressing mode, terminate it
$oper->{"DeleteInProgress"} = 1;
execute_actionlist($oper->{"EndAction"}, $desc);
delete $corr_list{$key};
}
}
# if there was no event correlation operation for the key when this
# function was called (or the operation was terminated previously
# within this function), start the new operation
if (!exists($corr_list{$key})) {
if (scalar(%{$subst})) {
if (exists($rule->{"InitActVolat"})) {
$initaction = [];
copy_actionlist($rule->{"InitAction"}, $initaction);
subst_actionlist($subst, $initaction, '$');
} else { $initaction = $rule->{"InitAction"}; }
if (exists($rule->{"SlideActVolat"})) {
$slideaction = [];
copy_actionlist($rule->{"SlideAction"}, $slideaction);
subst_actionlist($subst, $slideaction, '$');
} else { $slideaction = $rule->{"SlideAction"}; }
if (exists($rule->{"EndActVolat"})) {
$endaction = [];
copy_actionlist($rule->{"EndAction"}, $endaction);
subst_actionlist($subst, $endaction, '$');
} else { $endaction = $rule->{"EndAction"}; }
if (exists($rule->{"ActVolat"})) {
$action = [];
copy_actionlist($rule->{"Action"}, $action);
subst_actionlist($subst, $action, '$');
} else { $action = $rule->{"Action"}; }
} else {
$initaction = $rule->{"InitAction"};
$slideaction = $rule->{"SlideAction"};
$endaction = $rule->{"EndAction"};
$action = $rule->{"Action"};
}
$corr_list{$key} = { "StartTime" => $time,
"Time" => $time,
"Type" => $rule->{"Type"},
"File" => $conffile,
"ID" => $rule->{"ID"},
"Window" => $rule->{"Window"},
"AllTimes" => [],
"Desc" => $desc,
"InitAction" => $initaction,
"SlideAction" => $slideaction,
"EndAction" => $endaction,
"Action" => $action };
for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
$corr_list{$key}->{"TimesList"}->[$i] = [];
}
$corr_list{$key}->{"InitInProgress"} = 1;
execute_actionlist($initaction, $desc);
# if the init action terminated the operation, return
if (!exists($corr_list{$key})) { return; }
delete $corr_list{$key}->{"InitInProgress"};
}
$oper = $corr_list{$key};
# if the operation is not in event suppressing mode, record data about
# the current event into occurrence time lists (done before count action
# is executed, so that the action would see the current event in the window)
if (!exists($oper->{"SuppressMode"})) {
push @{$oper->{"AllTimes"}}, [$time, $index];
push @{$oper->{"TimesList"}->[$index]}, $time;
if (exists($rule->{"EGrpPattern"})) {
$oper->{"AllTimes"}->[-1]->[2] = $rule->{"EGrpTokenList"}->[$index];
if (scalar(%{$subst})) {
subst_string($subst, $oper->{"AllTimes"}->[-1]->[2], '$');
}
}
}
# execute count action for the given event type
if (scalar(%{$subst}) && exists($rule->{"CountActVolatList"}->{$index})) {
$countaction = [];
copy_actionlist($rule->{"CountActionList"}->[$index], $countaction);
subst_actionlist($subst, $countaction, '$');
} else { $countaction = $rule->{"CountActionList"}->[$index]; }
execute_actionlist($countaction, $desc);
# if the count action terminated the operation, return
if (!exists($corr_list{$key})) { return; }
# if the operation is in event suppressing mode, return
if (exists($oper->{"SuppressMode"})) { return; }
# check threshold conditions for all event types - if for some event type
# the number of events is below threshold, return
for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
if (scalar(@{$oper->{"TimesList"}->[$i]}) <
$rule->{"ThresholdList"}->[$i]) { return; }
}
# if event group pattern has been provided by the rule, call a function
# that creates an event group string and matches it with the event group
# pattern; if the pattern is not matching, return
if (exists($rule->{"EGrpPattern"})) {
if (!$matchegrpfunc[$rule->{"EGrpPatType"}]->($rule->{"EGrpPattern"},
$oper->{"AllTimes"})) {
return;
}
}
# if all threshold conditions are met, go to suppressing mode if specified by
# the rule, and execute the rule action (if setwpos action gets executed for
# the operation, it will appear in suppressing mode if specified by the rule)
if (!exists($rule->{"MultipleActions"})) { $oper->{"SuppressMode"} = 1; }
execute_actionlist($oper->{"Action"}, $desc);
}
# Parameters: par1 - reference to the rule definition
# par2 - reference to the hash of match values
# par3 - name of the configuration file
# par4 - trace hash for detecting loops during recursive calls
# Action: process the Jump rule after a match has been found. If the
# processing of rule file sets referenced by Jump is terminated by
# the continue*=EndMatch statement, return 1, otherwise return 0.
sub process_jump_rule {
my($rule, $subst, $conffile, $trace) = @_;
my($cfsetlist, $cfset, $cf);
if (!exists($rule->{"CFSet"})) { return 0; }
if (!defined($trace)) { $trace = {}; }
if (!exists($rule->{"ConstSet"}) && scalar(%{$subst})) {
$cfsetlist = [ @{$rule->{"CFSet"}} ];
subst_string($subst, @{$cfsetlist}, '$');
} else {
$cfsetlist = $rule->{"CFSet"};
}
foreach $cfset (@{$cfsetlist}) {
if (exists($trace->{$cfset})) {
log_msg(LOG_WARN,
"Can't jump to fileset '$cfset' from $conffile, loop detected");
next;
}
if (!exists($cfset2cfile{$cfset})) {
log_msg(LOG_WARN,
"Can't jump to fileset '$cfset' from $conffile, set does not exist");
next;
}
# process the files in the set by calling process_rules() recursively;
# the set name is recorded to %trace, in order to detect loops;
# if the processing in the rule file set is terminated by the
# continue*=EndMatch statement, end processing and return 1
$trace->{$cfset} = 1;
foreach $cf (@{$cfset2cfile{$cfset}}) {
if (process_rules($cf, $trace)) {
delete $trace->{$cfset};
return 1;
}
}
delete $trace->{$cfset};
}
return 0;
}
# Parameters: par1 - reference to the Pair* rule definition
# Action: search the event correlation operations associated with the Pair*
# rule par1 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 match_pair_operations {
my($rule) = $_[0];
my($ret, $key, $oper);
my(%subst, @context2, @action2);
$ret = 0; # shows if matches were found
foreach $key (keys %{$rule->{"Operations"}}) {
# since operations might be cancelled by other operations in this loop,
# check if operation with the given key still exists
if (!exists($rule->{"Operations"}->{$key})) { next; }
$oper = $rule->{"Operations"}->{$key};
# check if the rule context expression must be evaluated before
# comparing input line(s) with the pattern
if (exists($rule->{"ContPreEval2"}) &&
!tval_context_expr($oper->{"Context2"})) { next; }
# check if last N lines of input buffer match the pattern specified
# by operation; if the pattern returned any values, assign them to %subst,
# otherwise leave %subst empty
if ($matchfunc[$rule->{"PatType2"}]->($rule->{"PatLines2"},
$oper->{"Pattern2"},
\%subst, $rule->{"VarMap2"})) {
# evaluate the context expression of the rule
if (scalar(@{$oper->{"Context2"}}) &&
!exists($rule->{"ContPreEval2"})) {
if (scalar(%subst) && exists($rule->{"ContVolat2"})) {
copy_context($oper->{"Context2"}, \@context2);
subst_context(\%subst, \@context2, '$');
if (!tval_context_expr(\@context2)) { next; }
} else {
if (!tval_context_expr($oper->{"Context2"})) { next; }
}
}
# if the operation type is Pair, execute the 2nd action if the
# correlation window has not expired, and terminate the operation
if ($rule->{"Type"} == PAIR) {
if (!$oper->{"Window"} ||
time() - $oper->{"Time"} <= $oper->{"Window"}) {
$ret = 1;
++$rule->{"MatchCount"};
if (scalar(%subst)) {
if (exists($rule->{"ActVolat2"})) {
if (!exists($oper->{"Act2Copied"})) {
copy_actionlist($rule->{"Action2"}, \@action2);
$oper->{"Action2"} = \@action2;
}
subst_actionlist(\%subst, $oper->{"Action2"}, '$');
}
subst_string(\%subst, $oper->{"Desc2"}, '$');
}
execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
}
delete $corr_list{$key};
delete $rule->{"Operations"}->{$key};
}
# if the operation type is PairWithWindow, execute the 2nd action and
# terminate the operation (note that the event correlation window is
# not checked for the execution of the 1st action, in order to achieve
# good event ordering - if the 1st action creates a synthetic event,
# it would always appear after the current event)
elsif ($rule->{"Type"} == PAIR_W_WINDOW) {
$ret = 1;
++$rule->{"MatchCount"};
if (scalar(%subst)) {
if (exists($rule->{"ActVolat2"})) {
if (!exists($oper->{"Act2Copied"})) {
copy_actionlist($rule->{"Action2"}, \@action2);
$oper->{"Action2"} = \@action2;
}
subst_actionlist(\%subst, $oper->{"Action2"}, '$');
}
subst_string(\%subst, $oper->{"Desc2"}, '$');
}
execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
delete $corr_list{$key};
delete $rule->{"Operations"}->{$key};
}
}
}
# if there were 1 or more matches found, return 1, otherwise return 0
return $ret;
}
# Parameters: par1 - name of the configuration file
# par2 - rule index inside the configuration file
# par3 - trace hash for detecting loops during recursive calls
# (this parameter is needed for processing Jump rules)
# Action: match the par2-th rule from the file par1 against input, and
# process the rule if match was found.
# The function returns the rule index in the configuration file
# where the processing should continue.
sub match_1pattern_rule {
my($conffile, $index, $trace) = @_;
my($rule, %subst, @context);
$rule = $configuration{$conffile}->[$index];
# check if the rule context expression must be evaluated before
# comparing input line(s) with the pattern; if the expression
# evaluates FALSE, continue processing from the next rule
if (exists($rule->{"ContPreEval"}) &&
!tval_context_expr($rule->{"Context"})) { return $index+1; }
# check if last N lines of input buffer match the pattern specified
# by rule; if the pattern returned any values, assign them to %subst,
# otherwise leave %subst empty
if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"},
$rule->{"Pattern"},
\%subst, $rule->{"VarMap"})) {
# evaluate the context expression of the rule; if the expression
# evaluates FALSE, continue processing from the next rule
if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) {
if (scalar(%subst) && exists($rule->{"ContVolat"})) {
copy_context($rule->{"Context"}, \@context);
subst_context(\%subst, \@context, '$');
if (!tval_context_expr(\@context)) { return $index+1; }
} else {
if (!tval_context_expr($rule->{"Context"})) { return $index+1; }
}
}
# increment the counter that reflects the rule usage
++$rule->{"MatchCount"};
# process the rule (note that the GoTo field is set to $index+1
# if continue=TakeNext; -1 if continue=EndMatch; "total number
# of rules in the current configuration file" if continue=DontCont
# if rule is of type SUPPRESS, return immediately (note that
# the GotoRule field is set to total number of rules in the current
# configuration file which denotes end of processing for the file)
if ($rule->{"Type"} == SUPPRESS) { return $rule->{"GotoRule"}; }
# if rule is of type JUMP, process the rule with the extra $trace
# parameter for detecting processing loops, and return the number of
# the rule specified with continue; if during recursive processing
# continue*=EndMatch statement was encountered, return -1 as if
# continue=EndMatch for this Jump rule
if ($rule->{"Type"} == JUMP) {
if ($processrulefunc[JUMP]->($rule, \%subst, $conffile, $trace)) {
return -1;
} else {
return $rule->{"GotoRule"};
}
}
# generic processing for other rule types
$processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile);
return $rule->{"GotoRule"};
}
# if the pattern did not match, continue processing from the next rule
return $index+1;
}
# Parameters: par1 - name of the configuration file
# par2 - rule index inside the configuration file
# Action: match the par2-th rule from the file par1 against input, and
# process the rule if match was found.
# The function returns the rule index in the configuration file
# where the processing should continue.
sub match_2pattern_rule {
my($conffile, $index) = @_;
my($rule, %subst, @context);
$rule = $configuration{$conffile}->[$index];
CHECK_1ST_PAT: {
# check if the rule context expression must be evaluated before comparing
# input line(s) with the pattern; if the expression evaluates FALSE,
# process event correlation operations associated with the rule and check
# if their 2nd patterns match
if (exists($rule->{"ContPreEval"}) &&
!tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; }
# check if last N lines of input buffer match the pattern specified
# by rule; if the pattern returned any values, assign them to %subst,
# otherwise leave %subst empty
if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"},
$rule->{"Pattern"},
\%subst, $rule->{"VarMap"})) {
# evaluate the context expression of the rule; if the expression
# evaluates FALSE, process event correlation operations associated
# with the rule and check if their 2nd patterns match
if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) {
if (scalar(%subst) && exists($rule->{"ContVolat"})) {
copy_context($rule->{"Context"}, \@context);
subst_context(\%subst, \@context, '$');
if (!tval_context_expr(\@context)) { last CHECK_1ST_PAT; }
} else {
if (!tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; }
}
}
# increment the counter that reflects the rule usage
++$rule->{"MatchCount"};
# process the rule
$processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile);
# return the number of the rule specified with continue (note that
# for TakeNext the GotoRule field is set to $index+1, for DontCont
# it is set to total number of rules in the file, while for EndMatch
# it is set to -1)
return $rule->{"GotoRule"};
}
} # end of CHECK_1ST_PAT
# if the pattern did not match, process event correlation operations
# associated with the rule and check if their 2nd patterns match
if (scalar(%{$rule->{"Operations"}}) && match_pair_operations($rule)) {
return $rule->{"GotoRule2"};
}
# if there were no operations or no matching 2nd patterns, continue
# processing from the next rule
return $index+1;
}
# Parameters: par1 - name of the configuration file
# par2 - rule index inside the configuration file
# Action: match the par2-th rule from the file par1 against input, and
# process the rule if match was found.
# The function returns the rule index in the configuration file
# where the processing should continue.
sub match_eventgroup_rule {
my($conffile, $index) = @_;
my($rule, $i, %subst, @context);
$rule = $configuration{$conffile}->[$index];
for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
# check if the rule context expression must be evaluated before
# comparing input line(s) with the pattern; if the expression
# evaluates FALSE, move to the next pattern
if (exists($rule->{"ContPreEvalList"}->{$i}) &&
!tval_context_expr($rule->{"ContextList"}->[$i])) { next; }
# check if last N lines of input buffer match the pattern specified
# by rule; if the pattern returned any values, assign them to %subst,
# otherwise leave %subst empty
if ($matchfunc[$rule->{"PatTypeList"}->[$i]]->(
$rule->{"PatLinesList"}->[$i],
$rule->{"PatternList"}->[$i],
\%subst,
$rule->{"VarMapList"}->[$i])
) {
# evaluate the context expression of the rule; if the expression
# evaluates FALSE, move to the next pattern
if (scalar(@{$rule->{"ContextList"}->[$i]}) &&
!exists($rule->{"ContPreEvalList"}->{$i})) {
if (scalar(%subst) && exists($rule->{"ContVolatList"}->{$i})) {
copy_context($rule->{"ContextList"}->[$i], \@context);
subst_context(\%subst, \@context, '$');
if (!tval_context_expr(\@context)) { next; }
} else {
if (!tval_context_expr($rule->{"ContextList"}->[$i])) { next; }
}
}
# increment the counter that reflects the rule usage
++$rule->{"MatchCount"};
# process the rule
$processrulefunc[EVENT_GROUP]->($rule, \%subst, $conffile, $i);
# return the number of the rule specified with continue for current
# pattern (note that for TakeNext the GotoRule field is set to $index+1,
# for DontCont it is set to total number of rules in the file, while
# for EndMatch it is set to -1)
return $rule->{"GotoRuleList"}->[$i];
}
}
# if there was no matching pattern, continue processing from the next rule
return $index+1;
}
# Parameters: par1 - name of the configuration file
# par2 - trace hash for detecting loops during recursive calls
# Action: match the rules from configuration file par1 against the current
# content of input buffer. If during the matching continue*=EndMatch
# statement is encountered, return 1, otherwise return 0.
sub process_rules {
my($conffile, $trace) = @_;
my($i, $n, $rule, $cpu_total, $cpu_user, $cpu_sys);
$i = 0;
$n = scalar(@{$configuration{$conffile}});
# with --ruleperf option, collect CPU time data when rules are processed
if ($ruleperf) {
while ($i < $n) {
$rule = $configuration{$conffile}->[$i];
# skip the CALENDAR rule
if ($rule->{"Type"} == CALENDAR) { ++$i; next; }
# find CPU time of the process before the rule is processed
($cpu_user, $cpu_sys) = times();
$cpu_total = $cpu_user + $cpu_sys;
# match the i-th rule against input
$i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace);
# find CPU time of the process after the rule has been processed
# and calculate CPU time spent for processing the rule
($cpu_user, $cpu_sys) = times();
$rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total;
# increment the counter of total events processed by the rule
++$rule->{"EventCount"};
# if the rule matching function returned -1 for the offset of
# the next rule to be matched, terminate all matching and return 1
if ($i == -1) { return 1; }
}
} else {
while ($i < $n) {
$rule = $configuration{$conffile}->[$i];
# skip the CALENDAR rule
if ($rule->{"Type"} == CALENDAR) { ++$i; next; }
# match the i-th rule against input
$i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace);
# if the rule matching function returned -1 for the offset of
# the next rule to be matched, terminate all matching and return 1
if ($i == -1) { return 1; }
}
}
return 0;
}
# 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, $rule, $oper);
my($time, @time, $pevt, $event, $context, @buffer, $file, $peer);
my($minute, $hour, $day, $month, $year, $weekday);
my($lastdayofmonth, $shortyear, $cpu_total, $cpu_user, $cpu_sys);
# 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 = ();
$time = time();
foreach $pevt (@pending_events) {
if ($time >= $pevt->[0]) {
$event = $pevt->[1];
$context = $pevt->[2];
log_msg(LOG_DEBUG, "Creating event '$event'");
push @events, $event, $context;
} else { push @buffer, $pevt; }
}
@pending_events = @buffer;
}
# check the status of new connections over TCP and unix stream sockets
# which are not yet established
if (scalar(%output_tcpconn)) {
foreach $peer (keys %output_tcpconn) {
check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer");
}
}
if (scalar(%output_ustrconn)) {
foreach $file (keys %output_ustrconn) {
check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket");
}
}
# detect established connections over TCP and unix stream sockets that
# have been closed by peers or have errors, and close relevant sockets
if (scalar(%output_tcpsock)) {
check_established_conns(\%output_tcpsock, "TCP peer");
}
if (scalar(%output_ustream)) {
check_established_conns(\%output_ustream, "socket");
}
# process CALENDAR rules
@time = localtime(time());
$minute = $time[1];
$hour = $time[2];
$day = $time[3];
$month = $time[4];
$year = $time[5];
$weekday = $time[6];
$lastdayofmonth = ((localtime(time()+86400))[3] == 1);
$shortyear = $year % 100;
foreach $rule (@calendar) {
# if we have already executed an action in the current minute, skip
if ($minute == $rule->{"LastActionMinute"} &&
$hour == $rule->{"LastActionHour"} &&
$day == $rule->{"LastActionDay"} &&
$month == $rule->{"LastActionMonth"} &&
$year == $rule->{"LastActionYear"}) { next; }
# if one of the time conditions does not hold, skip
if (!exists($rule->{"Minutes"}->{$minute})) { next; }
if (!exists($rule->{"Hours"}->{$hour})) { next; }
if (!exists($rule->{"Days"}->{$day}) &&
!($lastdayofmonth && exists($rule->{"Days"}->{"0"}))) { next; }
if (!exists($rule->{"Months"}->{$month})) { next; }
if (!exists($rule->{"Weekdays"}->{$weekday})) { next; }
if (!exists($rule->{"Years"}->{$shortyear})) { next; }
# with --ruleperf option, find process CPU time before rule is processed
if ($ruleperf) {
($cpu_user, $cpu_sys) = times();
$cpu_total = $cpu_user + $cpu_sys;
}
# if the rule has no context expression, or the context expression
# exists and evaluates true, execute the action list of the calendar
# event and save current time
if (!scalar(@{$rule->{"Context"}}) ||
tval_context_expr($rule->{"Context"})) {
execute_actionlist($rule->{"Action"}, $rule->{"Desc"});
$rule->{"LastActionMinute"} = $minute;
$rule->{"LastActionHour"} = $hour;
$rule->{"LastActionDay"} = $day;
$rule->{"LastActionMonth"} = $month;
$rule->{"LastActionYear"} = $year;
++$rule->{"MatchCount"};
}
# with --ruleperf option, find process CPU time after rule has been
# processed and calculate CPU time spent for processing the rule,
# and increment the counter of total events processed by the rule
if ($ruleperf) {
($cpu_user, $cpu_sys) = times();
$rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total;
++$rule->{"EventCount"};
}
}
# accomplish clock-based tasks that are associated with elements of
# %corr_list (event correlation operations) and remove obsolete elements
foreach $key (keys %corr_list) {
# since operations might be cancelled by other operations in this loop,
# check if operation with the given key still exists
if (!exists($corr_list{$key})) { next; }
$oper = $corr_list{$key};
$time = time();
# if the correlation window has not expired, move to next operation
if ($time - $oper->{"Time"} <= $oper->{"Window"}) { next; }
$rule = $configuration{$oper->{"File"}}->[$oper->{"ID"}];
# ------------------------------------------------------------
# SINGLE_W_SUPPRESS rule
# ------------------------------------------------------------
if ($oper->{"Type"} == SINGLE_W_SUPPRESS) {
delete $corr_list{$key}; # terminate the operation
}
# ------------------------------------------------------------
# PAIR rule
# ------------------------------------------------------------
elsif ($oper->{"Type"} == PAIR) {
# if the window is not set to infinity, terminate the operation
if ($oper->{"Window"}) {
delete $corr_list{$key};
delete $rule->{"Operations"}->{$key};
}
}
# ------------------------------------------------------------
# PAIR_W_WINDOW rule
# ------------------------------------------------------------
elsif ($oper->{"Type"} == PAIR_W_WINDOW) {
# execute the 1st action and terminate the operation
execute_actionlist($oper->{"Action"}, $oper->{"Desc"});
delete $corr_list{$key};
delete $rule->{"Operations"}->{$key};
}
# ------------------------------------------------------------
# SINGLE_W_THRESHOLD rule
# ------------------------------------------------------------
elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) {
if (!exists($oper->{"SuppressMode"})) {
# if the operation is not in suppress mode, slide the window forward;
# if no events remain in the window, terminate the operation
update_times_swt($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
# if the operation is in suppress mode, terminate it
execute_actionlist($oper->{"Action2"}, $oper->{"Desc"});
delete $corr_list{$key};
}
}
# ------------------------------------------------------------
# SINGLE_W_2_THRESHOLDS rule
# ------------------------------------------------------------
elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) {
if (!exists($oper->{"2ndPass"})) {
# if the operation is in rising threshold mode, slide the window
# forward; if no events remain in the window, terminate the operation
update_times_swt($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; }
} else {
# if the operation is in falling threshold mode, terminate it
execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
delete $corr_list{$key};
}
}
# ------------------------------------------------------------
# EVENT_GROUP rule
# ------------------------------------------------------------
elsif ($oper->{"Type"} == EVENT_GROUP) {
if (!exists($oper->{"SuppressMode"})) {
# if the operation is not in suppress mode, slide the window forward;
# if no events remain in the window, terminate the operation
update_times_eg($oper, $time - $oper->{"Window"});
if (!scalar(@{$oper->{"AllTimes"}})) {
$oper->{"DeleteInProgress"} = 1;
execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
delete $corr_list{$key};
} else {
execute_actionlist($oper->{"SlideAction"}, $oper->{"Desc"});
}
} else {
# if the operation window has expired and the operation is in
# event suppressing mode, terminate it
$oper->{"DeleteInProgress"} = 1;
execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
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] == WRITEN) {
$result .= "writen " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CLOSEF) {
$result .= "closef " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == OWRITECL) {
$result .= "owritecl " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == UDGRAM) {
$result .= "udgram " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CLOSEUDGR) {
$result .= "closeudgr " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == USTREAM) {
$result .= "ustream " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CLOSEUSTR) {
$result .= "closeustr " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == UDPSOCK) {
$result .= "udpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CLOSEUDP) {
$result .= "closeudp " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == TCPSOCK) {
$result .= "tcpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CLOSETCP) {
$result .= "closetcp " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == SHELLCOMMAND) {
$result .= "shellcmd " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == COMMANDEXEC) {
$result .= "cmdexec " . join(" ", @{$actionlist->[$i+1]});
$i += 2;
}
elsif ($actionlist->[$i] == SPAWN) {
$result .= "spawn " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == SPAWNEXEC) {
$result .= "spawnexec " . join(" ", @{$actionlist->[$i+1]});
$i += 2;
}
elsif ($actionlist->[$i] == CSPAWN) {
$result .= "cspawn " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CSPAWNEXEC) {
$result .= "cspawnexec " . $actionlist->[$i+1]
. " " . join(" ", @{$actionlist->[$i+2]});
$i += 3;
}
elsif ($actionlist->[$i] == PIPE) {
$result .= "pipe " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == PIPEEXEC) {
$result .= "pipeexec " . $actionlist->[$i+1]
. " " . join(" ", @{$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] == PREPEND) {
$result .= "prepend " . $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] == REPORTEXEC) {
$result .= "reportexec " . $actionlist->[$i+1]
. " " . join(" ", @{$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] == POP) {
$result .= "pop " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == SHIFT) {
$result .= "shift " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == EXISTS) {
$result .= "exists %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == GETSIZE) {
$result .= "getsize %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == GETALIASES) {
$result .= "getaliases %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == GETLIFETIME) {
$result .= "getltime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == SETLIFETIME) {
$result .= "setltime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == GETCTIME) {
$result .= "getctime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == SETCTIME) {
$result .= "setctime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == EVENT) {
$result .= "event " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == TEVENT) {
$result .= "tevent " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == CEVENT) {
$result .= "cevent " . $actionlist->[$i+1] . " "
. $actionlist->[$i+2] . " " . $actionlist->[$i+3];
$i += 4;
}
elsif ($actionlist->[$i] == RESET) {
$result .= "reset " . $actionlist->[$i+2] . " " . $actionlist->[$i+3];
$i += 4;
}
elsif ($actionlist->[$i] == GETWINPOS) {
$result .= "getwpos %" . $actionlist->[$i+1] . " "
. $actionlist->[$i+3] . " " . $actionlist->[$i+4];
$i += 5;
}
elsif ($actionlist->[$i] == SETWINPOS) {
$result .= "setwpos " . $actionlist->[$i+1] . " "
. $actionlist->[$i+3] . " " . $actionlist->[$i+4];
$i += 5;
}
elsif ($actionlist->[$i] == ASSIGN) {
$result .= "assign %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == ASSIGNSQ) {
$result .= "assignsq %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == FREE) {
$result .= "free %" . $actionlist->[$i+1];
$i += 2;
}
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;
}
elsif ($actionlist->[$i] == LCALL) {
$result .= "lcall %" . $actionlist->[$i+1]
. " " . join(" ", @{$actionlist->[$i+3]}) . " ";
if ($actionlist->[$i+4]) { $result .= ":>" } else { $result .= "->" }
$result .= " " . $actionlist->[$i+2];
$i += 5;
}
elsif ($actionlist->[$i] == REWRITE) {
$result .= "rewrite " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == ADDINPUT) {
$result .= "addinput " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]
. " " . $actionlist->[$i+3];
$i += 4;
}
elsif ($actionlist->[$i] == DROPINPUT) {
$result .= "dropinput " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == SIGEMUL) {
$result .= "sigemul " . $actionlist->[$i+1];
$i += 2;
}
elsif ($actionlist->[$i] == VARIABLESET) {
$result .= "varset %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
$i += 3;
}
elsif ($actionlist->[$i] == IF) {
$result .= "if %" . $actionlist->[$i+1] . " (";
if (scalar(@{$actionlist->[$i+2]})) {
$result .= actionlist2str($actionlist->[$i+2]);
}
if (scalar(@{$actionlist->[$i+3]})) {
$result .= ") else (";
$result .= actionlist2str($actionlist->[$i+3]);
}
$result .= ")";
$i += 4;
}
elsif ($actionlist->[$i] == WHILE) {
$result .= "while %" . $actionlist->[$i+1] . " (";
if (scalar(@{$actionlist->[$i+2]})) {
$result .= actionlist2str($actionlist->[$i+2]);
}
$result .= ")";
$i += 3;
}
elsif ($actionlist->[$i] == BREAK) {
$result .= "break";
++$i;
}
elsif ($actionlist->[$i] == CONTINUE) {
$result .= "continue";
++$i;
}
else { return "Unknown action type in the action list"; }
$result .= "; ";
}
return $result;
}
# Parameters: par1 - pattern type
# par2 - pattern lines
# par3 - pattern
# Action: convert pattern to a printable representation
sub pattern2str {
my($type, $lines, $pattern) = @_;
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 == CACHED) {
return "cached match: $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 == NCACHED) {
return "negative cached match: $pattern";
}
elsif ($type == TVALUE) {
return "truth value: " . ($pattern?"TRUE":"FALSE");
}
else { return "Unknown pattern type"; }
}
# Parameters: par1 - continue value
# par2 - rule number
# Action: convert continue parameters to a printable representation
sub continue2str {
my($whatnext, $gotorule) = @_;
if ($whatnext == DONTCONT) { return "don't continue"; }
elsif ($whatnext == TAKENEXT) { return "take next"; }
elsif ($whatnext == GOTO) { return "goto rule " . ($gotorule + 1); }
elsif ($whatnext == ENDMATCH) { return "end matching"; }
else { return "Unknown continue value"; }
}
# Parameters: par1 - reference to a context expression
# 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] == CCODE2) {
$op1 = $ref->[$i+1];
$op2 = $ref->[$i+2];
push @stack, join(" ", @{$op1}) . " :> $op2";
$i += 3;
}
elsif ($ref->[$i] == VARSET) {
$op1 = $ref->[$i+1];
push @stack, "varset $op1";
$i += 2;
}
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;
}
else { return "Unknown operator in the context expression"; }
}
$result = pop @stack;
if (!defined($result)) { $result = ""; }
return $result;
}
# Parameters: par1 - filehandle
# par2 - key of event correlation operation
# par3 - reference to event correlation operation
# Action: print given event correlation operation to the filehandle
sub print_operation {
my($handle, $key, $oper) = @_;
my($rule, $conffile, $id, $time, $elem, $i, $j);
print $handle "Key: ", $key, "\n";
print $handle "Operation started at: ",
scalar(localtime($oper->{"StartTime"})), "\n";
print $handle "Correlation window begins at: ",
scalar(localtime($oper->{"Time"})), "\n";
if ($oper->{"Window"}) {
print $handle "Correlation window ends at: ",
scalar(localtime($oper->{"Time"} + $oper->{"Window"})), "\n";
}
$conffile = $oper->{"File"};
$id = $oper->{"ID"};
$rule = $configuration{$conffile}->[$id];
print $handle "Configuration file: ", $conffile, "\n";
print $handle "Rule number: ", $id+1, "\n";
print $handle "Rule internal ID: ", $id, "\n";
if ($oper->{"Type"} == SINGLE_W_SUPPRESS) {
print $handle "Type: SingleWithSuppress\n";
print $handle "Pattern: ";
print $handle pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
print $handle "\n";
print $handle "Context: ";
print $handle context2str($rule->{"Context"});
print $handle "\n";
print $handle "Behavior after match: ";
print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
print $handle "\n";
}
elsif ($oper->{"Type"} == PAIR) {
print $handle "Type: Pair\n";
print $handle "Pattern: ";
print $handle pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
print $handle "\n";
print $handle "Context: ";
print $handle context2str($rule->{"Context"});
print $handle "\n";
print $handle "Behavior after match: ";
print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Pattern2: ";
print $handle pattern2str($rule->{"PatType2"},
$rule->{"PatLines2"}, $oper->{"Pattern2"});
print $handle "\n";
print $handle "Context2: ";
print $handle context2str($oper->{"Context2"});
print $handle "\n";
print $handle "Behavior after match2: ";
print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"});
print $handle "\n";
print $handle "Description2: ", $oper->{"Desc2"}, "\n";
print $handle "Action2: ";
print $handle actionlist2str($oper->{"Action2"});
print $handle "\n";
if ($rule->{"Window"}) {
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
} else {
print $handle "Window: infinite\n";
}
print $handle "\n";
}
elsif ($oper->{"Type"} == PAIR_W_WINDOW) {
print $handle "Type: PairWithWindow\n";
print $handle "Pattern: ";
print $handle pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
print $handle "\n";
print $handle "Context: ";
print $handle context2str($rule->{"Context"});
print $handle "\n";
print $handle "Behavior after match: ";
print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Pattern2: ";
print $handle pattern2str($rule->{"PatType2"},
$rule->{"PatLines2"}, $oper->{"Pattern2"});
print $handle "\n";
print $handle "Context2: ";
print $handle context2str($oper->{"Context2"});
print $handle "\n";
print $handle "Behavior after match2: ";
print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"});
print $handle "\n";
print $handle "Description2: ", $oper->{"Desc2"}, "\n";
print $handle "Action2: ";
print $handle actionlist2str($oper->{"Action2"});
print $handle "\n";
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
print $handle "\n";
}
elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) {
print $handle "Type: SingleWithThreshold\n";
print $handle "Pattern: ";
print $handle pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
print $handle "\n";
print $handle "Context: ";
print $handle context2str($rule->{"Context"});
print $handle "\n";
print $handle "Behavior after match: ";
print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Action2: ";
print $handle actionlist2str($oper->{"Action2"});
print $handle "\n";
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
print $handle "Threshold: ", $rule->{"Threshold"}, "\n";
print $handle scalar(@{$oper->{"Times"}}), " events observed at ";
if (exists($oper->{"SuppressMode"})) {
print $handle "(seen before threshold was crossed):\n";
} else {
print $handle "(checking for threshold):\n";
}
foreach $time (@{$oper->{"Times"}})
{ print $handle scalar(localtime($time)), "\n"; }
print $handle "\n";
}
elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) {
print $handle "Type: SingleWith2Thresholds\n";
print $handle "Pattern: ";
print $handle pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
print $handle "\n";
print $handle "Context: ";
print $handle context2str($rule->{"Context"});
print $handle "\n";
print $handle "Behavior after match: ";
print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
print $handle "Threshold: ", $rule->{"Threshold"}, "\n";
print $handle "Description2: ", $oper->{"Desc2"}, "\n";
print $handle "Action2: ";
print $handle actionlist2str($oper->{"Action2"});
print $handle "\n";
print $handle "Window2: ", $rule->{"Window2"}, " seconds\n";
print $handle "Threshold2: ", $rule->{"Threshold2"}, "\n";
print $handle scalar(@{$oper->{"Times"}}), " events observed at ";
if (exists($oper->{"2ndPass"})) {
print $handle "(checking for 2nd threshold):\n";
} else {
print $handle "(checking for 1st threshold):\n";
}
foreach $time (@{$oper->{"Times"}})
{ print $handle scalar(localtime($time)), "\n"; }
print $handle "\n";
}
elsif ($oper->{"Type"} == EVENT_GROUP) {
print $handle "Type: EventGroup", $rule->{"EventNumber"}, "\n";
for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
$j = ($i==0)?"":($i+1);
print $handle "Pattern$j: ";
print $handle pattern2str($rule->{"PatTypeList"}->[$i],
$rule->{"PatLinesList"}->[$i],
$rule->{"PatternList"}->[$i]);
print $handle "\n";
print $handle "Context$j: ";
print $handle context2str($rule->{"ContextList"}->[$i]);
print $handle "\n";
print $handle "Behavior after match$j: ";
print $handle continue2str($rule->{"WhatNextList"}->[$i],
$rule->{"GotoRuleList"}->[$i]);
print $handle "\n";
print $handle "Count action$j: ";
print $handle actionlist2str($rule->{"CountActionList"}->[$i]);
print $handle "\n";
print $handle "Threshold$j: ";
print $handle $rule->{"ThresholdList"}->[$i];
print $handle "\n";
if (exists($rule->{"EGrpPattern"})) {
print $handle "Event group token$j: ";
print $handle $rule->{"EGrpTokenList"}->[$i];
print $handle "\n";
}
}
if (exists($rule->{"EGrpPattern"})) {
print $handle "Event group pattern: ";
print $handle pattern2str($rule->{"EGrpPatType"}, 1,
$rule->{"EGrpPattern"});
print $handle "\n";
print $handle "Event group string: ";
print $handle join(" ", map { $_->[2] } @{$oper->{"AllTimes"}});
print $handle "\n";
}
print $handle "Init action: ";
print $handle actionlist2str($oper->{"InitAction"});
print $handle "\n";
print $handle "Slide action: ";
print $handle actionlist2str($oper->{"SlideAction"});
print $handle "\n";
print $handle "End action: ";
print $handle actionlist2str($oper->{"EndAction"});
print $handle "\n";
print $handle "Description: ", $oper->{"Desc"}, "\n";
print $handle "Action: ";
print $handle actionlist2str($oper->{"Action"});
print $handle "\n";
print $handle "Window: ", $rule->{"Window"}, " seconds\n";
print $handle scalar(@{$oper->{"AllTimes"}}), " events observed at ";
if (exists($oper->{"SuppressMode"})) {
print $handle "(seen before thresholds were crossed):\n";
} else {
print $handle "(checking for thresholds):\n";
}
foreach $elem (@{$oper->{"AllTimes"}}) {
print $handle scalar(localtime($elem->[0]));
print $handle " (matched by pattern #", $elem->[1]+1;
if (exists($rule->{"EGrpPattern"})) {
print $handle ", event group token: ", $elem->[2];
}
print $handle ")\n";
}
print $handle "\n";
}
else { print $handle "Unknown operation type in the list\n\n"; }
}
# Parameters: -
# Action: save some information about the current state of the program
# to dump file.
sub dump_data {
my($dfilename, $dhandle, $i, $key, $ref, $file, $event, $fpos, @stat);
my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids);
my($len, $width1, $width2, $width3, $width4, $width5);
my($name, %reported_names);
# get the current time
$time = time();
# with --dumpfts command line option, include seconds since epoch
# in the dump file name as a suffix
if ($dumpfts) {
$dfilename = "$dumpfile.$time";
} else {
$dfilename = $dumpfile;
}
# verify that dumpfile does not exist and open it
if (-e $dfilename) {
log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists");
return;
}
if (!open($dhandle, ">$dfilename")) {
log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)");
return;
}
# print program info
print $dhandle "Program information:\n";
print $dhandle '=' x 60, "\n";
print $dhandle "Program version: ", $SEC_VERSION, "\n";
print $dhandle "Time of the start: ",
scalar(localtime($startuptime)), "\n";
print $dhandle "Time of the last configuration load: ",
scalar(localtime($lastconfigload)), "\n";
print $dhandle "Time of the dump: ", scalar(localtime($time)), "\n";
print $dhandle "Program resource file: ", $rcfile_status, "\n";
print $dhandle "Program options: ", $sec_options, "\n";
# note that $) can report the same supplementary group ID more than once
@gidlist = split(' ', $) );
$egid = shift @gidlist;
%gids = map { $_ => 1 } @gidlist;
print $dhandle "Effective user ID: ", $>, "\n";
print $dhandle "Effective group ID: ", $egid, "\n";
print $dhandle "Supplementary group IDs: ", join(" ", keys %gids), "\n";
print $dhandle "\n";
# print environment info
print $dhandle "Environment:\n";
print $dhandle '=' x 60, "\n";
foreach $key (sort(keys %ENV)) {
print $dhandle "$key=", $ENV{$key}, "\n";
}
print $dhandle "\n";
# print performance statistics
print $dhandle "Performance statistics:\n";
print $dhandle '=' x 60, "\n";
($user, $system, $cuser, $csystem) = times();
print $dhandle "Run time: ", $time - $startuptime, " seconds\n";
print $dhandle "User time: $user seconds\n";
print $dhandle "System time: $system seconds\n";
print $dhandle "Child user time: $cuser seconds\n";
print $dhandle "Child system time: $csystem seconds\n";
print $dhandle "Processed input lines: $processedlines\n";
print $dhandle "\n";
# print rule usage statistics
print $dhandle "Rule usage statistics:\n";
print $dhandle '=' x 60, "\n";
foreach $file (@conffiles) {
print $dhandle "\nStatistics for the rules from $file\n";
print $dhandle "(loaded at ",
scalar(localtime($config_ltimes{$file})), ")\n";
print $dhandle '-' x 60, "\n";
$width1 = length(sprintf("%u", scalar(@{$configuration{$file}})));
$width2 = $width3 = 0;
if ($ruleperf) { $width4 = $width5 = 0; }
foreach $ref (@{$configuration{$file}}) {
$len = length(sprintf("%u", $ref->{"LineNo"}));
if ($len > $width2) { $width2 = $len; }
$len = length(sprintf("%u", $ref->{"MatchCount"}));
if ($len > $width3) { $width3 = $len; }
if ($ruleperf) {
$len = length(sprintf("%.2f", $ref->{"CPUtime"}));
if ($len > $width4) { $width4 = $len; }
$len = length(sprintf("%u", $ref->{"EventCount"}));
if ($len > $width5) { $width5 = $len; }
}
}
$i = 1;
foreach $ref (@{$configuration{$file}}) {
printf $dhandle "Rule %*u line %*u matched %*u events",
$width1, $i, $width2, $ref->{"LineNo"}, $width3, $ref->{"MatchCount"};
if ($ruleperf) {
printf $dhandle
", %*.*f seconds of CPU time spent for processing %*u events",
$width4, 2, $ref->{"CPUtime"}, $width5, $ref->{"EventCount"};
}
print $dhandle " (", $ref->{"Desc"}, ")\n";
++$i;
}
}
print $dhandle "\n";
# print input sources
print $dhandle "Input sources:\n";
print $dhandle '=' x 60, "\n";
foreach $file (@inputfiles) {
print $dhandle $file, " ";
if ($inputsrc{$file}->{"open"}) {
print $dhandle "(status: Open, ";
if ($inputsrc{$file}->{"regfile"}) {
$fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
@stat = stat($inputsrc{$file}->{"fh"});
print $dhandle "type: regular file, ";
# sysseek returns a string "0 but true" for offset 0,
# so force numeric context by adding 0
print $dhandle "read offset: ", defined($fpos)?$fpos+0:"undef", ", ";
print $dhandle "file size: ", scalar(@stat)?$stat[7]:"undef";
} else {
print $dhandle "type: pipe";
}
print $dhandle ", ";
print $dhandle "device/inode: ", $inputsrc{$file}->{"dev"};
print $dhandle "/", $inputsrc{$file}->{"inode"}, ", ";
} else {
print $dhandle "(status: Closed, ";
}
print $dhandle "received data: ",
$inputsrc{$file}->{"lines"}, " lines, ";
if ($intcontexts) {
print $dhandle "context: ", $inputsrc{$file}->{"context"};
} else {
print $dhandle "no context set";
}
print $dhandle ")\n";
}
print $dhandle "\n";
# print the content of input buffer(s)
if ($jointbuf) {
print $dhandle "Input buffering mode: ";
print $dhandle "joint buffer for all input sources\n";
print $dhandle "Size of input buffer: $bufsize\n";
print $dhandle "\n";
print $dhandle "Content of input buffer (last $bufsize input line(s)):\n";
print $dhandle '-' x 60, "\n";
for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
print $dhandle $input_buffer[$i], "\n";
}
print $dhandle '-' x 60, "\n";
print $dhandle "\n";
print $dhandle "Last $bufsize input source(s):\n";
print $dhandle '-' x 60, "\n";
for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
if (defined($input_sources[$i])) {
print $dhandle $input_sources[$i], "\n";
} else {
print $dhandle "synthetic event\n";
}
}
print $dhandle '-' x 60, "\n";
print $dhandle "\n";
} else {
print $dhandle "Input buffering mode: ";
print $dhandle "separate buffer for each input source\n";
print $dhandle "Size of each input buffer: $bufsize\n";
print $dhandle "\n";
foreach $file (sort keys %input_buffers) {
print $dhandle "Content of input buffer for $file:\n";
print $dhandle '-' x 60, "\n";
for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1;
$i <= $input_buffers{$file}->{"BufPos"}; ++$i) {
print $dhandle $input_buffers{$file}->{"Events"}->[$i], "\n";
}
print $dhandle '-' x 60, "\n";
print $dhandle "\n";
}
print $dhandle "Content of input buffer for synthetic events:\n";
print $dhandle '-' x 60, "\n";
for ($i = $event_buffer{"BufPos"} - $bufsize + 1;
$i <= $event_buffer{"BufPos"}; ++$i) {
print $dhandle $event_buffer{"Events"}->[$i], "\n";
}
print $dhandle '-' x 60, "\n";
print $dhandle "\n";
}
# print the content of pending event buffer
$i = 0;
print $dhandle "Pending events:\n";
print $dhandle '=' x 60, "\n";
foreach $ref (@pending_events) {
print $dhandle "Event: ", $ref->[1], "\n";
print $dhandle "Will be created at ", scalar(localtime($ref->[0]));
if ($intcontexts) { print $dhandle " with context '", $ref->[2], "'"; }
print $dhandle "\n\n";
++$i;
}
print $dhandle "Total: $i elements\n\n";
# print the content of pattern match cache
$i = 0;
print $dhandle "Pattern match cache:\n";
print $dhandle '=' x 60, "\n";
while (($key, $ref) = each(%pmatch_cache)) {
print $dhandle "Match: ", $key, "\n";
foreach $name (sort keys %{$ref}) {
print $dhandle "$name = ",
defined($ref->{$name})?$ref->{$name}:"undef", "\n";
}
print $dhandle "\n";
++$i;
}
print $dhandle "Total: $i elements\n\n";
# print the list of active event correlation operations
$i = 0;
print $dhandle "List of event correlation operations:\n";
print $dhandle '=' x 60, "\n";
while (($key, $ref) = each(%corr_list)) {
print_operation($dhandle, $key, $ref);
print $dhandle '-' x 60, "\n";
++$i;
}
print $dhandle "Total: $i elements\n\n";
# print the list of active contexts
$i = 0;
%reported_names = ();
print $dhandle "List of contexts:\n";
print $dhandle '=' x 60, "\n";
while (($key, $ref) = each(%context_list)) {
if (exists($reported_names{$key})) { next; }
foreach $name (keys %{$ref->{"Aliases"}}) {
print $dhandle "Context Name: ", $name, "\n";
$reported_names{$name} = 1;
}
print $dhandle "Creation Time: ",
scalar(localtime($ref->{"Time"})), "\n";
if ($ref->{"Window"}) {
print $dhandle "Lifetime: ", $ref->{"Window"}, " seconds\n";
} else {
print $dhandle "Lifetime: infinite\n";
}
if (scalar(@{$ref->{"Action"}})) {
print $dhandle "Action on delete: ",
actionlist2str($ref->{"Action"});
print $dhandle " (%s = ", $ref->{"Desc"}, ")\n";
}
if (scalar(@{$ref->{"Buffer"}})) {
print $dhandle scalar(@{$ref->{"Buffer"}}),
" events associated with context:\n";
foreach $event (@{$ref->{"Buffer"}})
{ print $dhandle $event, "\n"; }
}
print $dhandle '-' x 60, "\n";
++$i;
}
print $dhandle "Total: $i elements\n\n";
# print the list of running children
$i = 0;
print $dhandle "Child processes:\n";
print $dhandle '=' x 60, "\n";
while (($key, $ref) = each(%children)) {
print $dhandle "Child PID: ", $key, "\n";
print $dhandle "Commandline started by child: ", $ref->{"cmd"}, "\n";
if ($ref->{"open"}) {
print $dhandle "Connected to pipe input";
if ($intcontexts && exists($ref->{"context"}))
{ print $dhandle " with context '", $ref->{"context"}, "'"; }
print $dhandle "\n";
}
print $dhandle '-' x 60, "\n";
++$i;
}
print $dhandle "Total: $i elements\n\n";
# print the values of action list variables
$i = 0;
print $dhandle "Action list variables:\n";
print $dhandle '=' x 60, "\n";
foreach $key (sort keys %variables) {
if (defined($variables{$key})) {
print $dhandle "%$key = '", $variables{$key}, "'\n";
} else {
print $dhandle "%$key = undef\n";
}
++$i;
}
print $dhandle "Total: $i elements\n\n";
close($dhandle);
log_msg(LOG_DEBUG, "Dump to $dfilename completed");
}
# Parameters: par1 - reference to hash where operation will be stored
# par2 - key of event correlation operation
# par3 - reference to event correlation operation
# Action: store given event correlation operation to the hash par1, so
# that it can be converted into JSON format (since perl is typeless
# language, numeric context is set for some fields by adding 0, in
# order to ensure their conversion into JSON numbers).
sub convert_operation {
my($ref, $key, $oper) = @_;
my($rule, $conffile, $id, $elem, $i, $j);
$ref->{"key"} = $key;
$ref->{"starttime"} = $oper->{"StartTime"} + 0;
$ref->{"windowstart"} = $oper->{"Time"} + 0;
if ($oper->{"Window"}) {
$ref->{"windowend"} = $oper->{"Time"} + $oper->{"Window"};
}
$conffile = $oper->{"File"};
$id = $oper->{"ID"};
$rule = $configuration{$conffile}->[$id];
$ref->{"configfile"} = $conffile;
$ref->{"ruleid"} = $id + 0;
if ($oper->{"Type"} == SINGLE_W_SUPPRESS) {
$ref->{"type"} = "SingleWithSuppress";
$ref->{"pattern"} = pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
$ref->{"context"} = context2str($rule->{"Context"});
$ref->{"continue"} = continue2str($rule->{"WhatNext"},
$rule->{"GotoRule"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"window"} = $rule->{"Window"} + 0;
}
elsif ($oper->{"Type"} == PAIR) {
$ref->{"type"} = "Pair";
$ref->{"pattern"} = pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
$ref->{"context"} = context2str($rule->{"Context"});
$ref->{"continue"} = continue2str($rule->{"WhatNext"},
$rule->{"GotoRule"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"pattern2"} = pattern2str($rule->{"PatType2"},
$rule->{"PatLines2"}, $oper->{"Pattern2"});
$ref->{"context2"} = context2str($oper->{"Context2"});
$ref->{"continue2"} = continue2str($rule->{"WhatNext2"},
$rule->{"GotoRule2"});
$ref->{"desc2"} = $oper->{"Desc2"};
$ref->{"action2"} = actionlist2str($oper->{"Action2"});
$ref->{"window"} = $rule->{"Window"} + 0;
}
elsif ($oper->{"Type"} == PAIR_W_WINDOW) {
$ref->{"type"} = "PairWithWindow";
$ref->{"pattern"} = pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
$ref->{"context"} = context2str($rule->{"Context"});
$ref->{"continue"} = continue2str($rule->{"WhatNext"},
$rule->{"GotoRule"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"pattern2"} = pattern2str($rule->{"PatType2"},
$rule->{"PatLines2"}, $oper->{"Pattern2"});
$ref->{"context2"} = context2str($oper->{"Context2"});
$ref->{"continue2"} = continue2str($rule->{"WhatNext2"},
$rule->{"GotoRule2"});
$ref->{"desc2"} = $oper->{"Desc2"};
$ref->{"action2"} = actionlist2str($oper->{"Action2"});
$ref->{"window"} = $rule->{"Window"} + 0;
}
elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) {
$ref->{"type"} = "SingleWithThreshold";
$ref->{"pattern"} = pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
$ref->{"context"} = context2str($rule->{"Context"});
$ref->{"continue"} = continue2str($rule->{"WhatNext"},
$rule->{"GotoRule"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"action2"} = actionlist2str($oper->{"Action2"});
$ref->{"window"} = $rule->{"Window"} + 0;
$ref->{"threshold"} = $rule->{"Threshold"} + 0;
if (exists($oper->{"SuppressMode"})) {
$ref->{"status"} = "threshold reached";
} else {
$ref->{"status"} = "checking for threshold";
}
$ref->{"eventtimes"} = [];
foreach $elem (@{$oper->{"Times"}}) {
push @{$ref->{"eventtimes"}}, $elem + 0;
}
}
elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) {
$ref->{"type"} = "SingleWith2Thresholds";
$ref->{"pattern"} = pattern2str($rule->{"PatType"},
$rule->{"PatLines"}, $rule->{"Pattern"});
$ref->{"context"} = context2str($rule->{"Context"});
$ref->{"continue"} = continue2str($rule->{"WhatNext"},
$rule->{"GotoRule"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"window"} = $rule->{"Window"} + 0;
$ref->{"threshold"} = $rule->{"Threshold"} + 0;
$ref->{"desc2"} = $oper->{"Desc2"};
$ref->{"action2"} = actionlist2str($oper->{"Action2"});
$ref->{"window2"} = $rule->{"Window2"} + 0;
$ref->{"threshold2"} = $rule->{"Threshold2"} + 0;
if (exists($oper->{"2ndPass"})) {
$ref->{"status"} = "checking for 2nd threshold";
} else {
$ref->{"status"} = "checking for 1st threshold";
}
$ref->{"eventtimes"} = [];
foreach $elem (@{$oper->{"Times"}}) {
push @{$ref->{"eventtimes"}}, $elem + 0;
}
}
elsif ($oper->{"Type"} == EVENT_GROUP) {
$ref->{"type"} = "EventGroup" . $rule->{"EventNumber"};
for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
$j = ($i==0)?"":($i+1);
$ref->{"pattern$j"} = pattern2str($rule->{"PatTypeList"}->[$i],
$rule->{"PatLinesList"}->[$i],
$rule->{"PatternList"}->[$i]);
$ref->{"context$j"} = context2str($rule->{"ContextList"}->[$i]);
$ref->{"continue$j"} = continue2str($rule->{"WhatNextList"}->[$i],
$rule->{"GotoRuleList"}->[$i]);
$ref->{"count$j"} = actionlist2str($rule->{"CountActionList"}->[$i]);
$ref->{"threshold$j"} = $rule->{"ThresholdList"}->[$i] + 0;
if (exists($rule->{"EGrpPattern"})) {
$ref->{"egtoken$j"} = $rule->{"EGrpTokenList"}->[$i];
}
}
if (exists($rule->{"EGrpPattern"})) {
$ref->{"egpattern"} = pattern2str($rule->{"EGrpPatType"}, 1,
$rule->{"EGrpPattern"});
$ref->{"egstring"} = join(" ", map { $_->[2] } @{$oper->{"AllTimes"}});
}
$ref->{"init"} = actionlist2str($oper->{"InitAction"});
$ref->{"slide"} = actionlist2str($oper->{"SlideAction"});
$ref->{"end"} = actionlist2str($oper->{"EndAction"});
$ref->{"desc"} = $oper->{"Desc"};
$ref->{"action"} = actionlist2str($oper->{"Action"});
$ref->{"window"} = $rule->{"Window"} + 0;
if (exists($oper->{"SuppressMode"})) {
$ref->{"status"} = "thresholds reached";
} else {
$ref->{"status"} = "checking for thresholds";
}
$ref->{"eventtimes"} = [];
$ref->{"eventpatterns"} = [];
if (exists($rule->{"EGrpPattern"})) { $ref->{"eventtokens"} = []; }
foreach $elem (@{$oper->{"AllTimes"}}) {
push @{$ref->{"eventtimes"}}, $elem->[0] + 0;
push @{$ref->{"eventpatterns"}}, $elem->[1] + 1;
if (exists($rule->{"EGrpPattern"})) {
push @{$ref->{"eventtokens"}}, $elem->[2];
}
}
}
else { $ref->{"status"} = "Unknown operation type in the list"; }
}
# Parameters: -
# Action: save some information about the current state of the program
# to dump file in JSON format (since perl is typeless language,
# numeric context is set for some fields by adding 0, in order
# to ensure their conversion into JSON numbers).
sub dump_data_json {
my($dfilename, $dhandle, $i, $key, $ref, $file, $fpos, @stat);
my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids);
my($name, %reported_names, %data, $json);
# get the current time
$time = time();
# with --dumpfts command line option, include seconds since epoch
# in the dump file name as a suffix
if ($dumpfts) {
$dfilename = "$dumpfile.$time";
} else {
$dfilename = $dumpfile;
}
# verify that dumpfile does not exist and open it
if (-e $dfilename) {
log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists");
return;
}
if (!open($dhandle, ">$dfilename")) {
log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)");
return;
}
%data = ();
# program info
$data{"program"} = {};
$data{"program"}->{"version"} = $SEC_VERSION;
$data{"program"}->{"startuptime"} = $startuptime + 0;
$data{"program"}->{"confloadtime"} = $lastconfigload + 0;
$data{"program"}->{"dumptime"} = $time + 0;
$data{"program"}->{"rcfile"} = $rcfile_status;
$data{"program"}->{"options"} = $sec_options;
# note that $) can report the same supplementary group ID more than once
@gidlist = split(' ', $) );
$egid = shift @gidlist;
%gids = map { $_ => 1 } @gidlist;
$data{"program"}->{"euid"} = $> + 0;
$data{"program"}->{"egid"} = $egid + 0;
$data{"program"}->{"sgid"} = [ map { $_ + 0 } keys %gids ];
# environment info
$data{"env"} = \%ENV;
# performance statistics
$data{"perf"} = {};
($user, $system, $cuser, $csystem) = times();
$data{"perf"}->{"runtime"} = $time - $startuptime;
$data{"perf"}->{"user"} = $user + 0;
$data{"perf"}->{"system"} = $system + 0;
$data{"perf"}->{"childuser"} = $cuser + 0;
$data{"perf"}->{"childsystem"} = $csystem + 0;
$data{"perf"}->{"lines"} = $processedlines + 0;
# rule usage statistics
$data{"rulestats"} = {};
foreach $file (@conffiles) {
$data{"rulestats"}->{$file} = {};
$data{"rulestats"}->{$file}->{"loadtime"} = $config_ltimes{$file} + 0;
$data{"rulestats"}->{$file}->{"stats"} = [];
foreach $ref (@{$configuration{$file}}) {
push @{$data{"rulestats"}->{$file}->{"stats"}},
{ "ruleline" => $ref->{"LineNo"} + 0,
"matches" => $ref->{"MatchCount"} + 0,
"desc" => $ref->{"Desc"} };
if ($ruleperf) {
$data{"rulestats"}->{$file}->{"stats"}->[-1]->{"events"} =
$ref->{"EventCount"} + 0;
$data{"rulestats"}->{$file}->{"stats"}->[-1]->{"cputime"} =
$ref->{"CPUtime"} + 0;
}
}
}
# input sources
$data{"inputs"} = {};
foreach $file (@inputfiles) {
$data{"inputs"}->{$file} = {};
$data{"inputs"}->{$file}->{"file"} = $file;
if ($inputsrc{$file}->{"open"}) {
$data{"inputs"}->{$file}->{"status"} = "Open";
if ($inputsrc{$file}->{"regfile"}) {
$fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
@stat = stat($inputsrc{$file}->{"fh"});
$data{"inputs"}->{$file}->{"type"} = "regular file";
# sysseek returns a string "0 but true" for offset 0,
# so force numeric context by adding 0
if (defined($fpos)) {
$data{"inputs"}->{$file}->{"offset"} = $fpos + 0;
}
if (scalar(@stat)) {
$data{"inputs"}->{$file}->{"size"} = $stat[7] + 0;
}
} else {
$data{"inputs"}->{$file}->{"type"} = "pipe";
}
# in the case of stdin, dev and inode equal to string value "-"
$data{"inputs"}->{$file}->{"dev"} = $inputsrc{$file}->{"dev"};
$data{"inputs"}->{$file}->{"inode"} = $inputsrc{$file}->{"inode"};
} else {
$data{"inputs"}->{$file}->{"status"} = "Closed";
}
$data{"inputs"}->{$file}->{"lines"} = $inputsrc{$file}->{"lines"} + 0;
if ($intcontexts) {
$data{"inputs"}->{$file}->{"context"} = $inputsrc{$file}->{"context"};
}
}
# content of input buffer(s)
$data{"buffer"} = {};
if ($jointbuf) {
$data{"buffer"}->{"bufmode"} = "joint buffer for all input sources";
$data{"buffer"}->{"bufsize"} = $bufsize + 0;
$data{"buffer"}->{"lastlines"} = [];
$data{"buffer"}->{"lastinputs"} = [];
for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
push @{$data{"buffer"}->{"lastlines"}}, $input_buffer[$i];
if (defined($input_sources[$i])) {
push @{$data{"buffer"}->{"lastinputs"}}, $input_sources[$i];
} else {
push @{$data{"buffer"}->{"lastinputs"}}, "synthetic event";
}
}
} else {
$data{"buffer"}->{"bufmode"} = "separate buffer for each input source";
$data{"buffer"}->{"bufsize"} = $bufsize + 0;
$data{"buffer"}->{"lastlines"} = {};
foreach $file (keys %input_buffers) {
$data{"buffer"}->{"lastlines"}->{$file} = [];
for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1;
$i <= $input_buffers{$file}->{"BufPos"}; ++$i) {
push @{$data{"buffer"}->{"lastlines"}->{$file}},
$input_buffers{$file}->{"Events"}->[$i];
}
}
$data{"buffer"}->{"lastsynevents"} = [];
for ($i = $event_buffer{"BufPos"} - $bufsize + 1;
$i <= $event_buffer{"BufPos"}; ++$i) {
push @{$data{"buffer"}->{"lastsynevents"}},
$event_buffer{"Events"}->[$i];
}
}
# content of pending event buffer
$i = 0;
$data{"pendingevents"} = [];
foreach $ref (@pending_events) {
$data{"pendingevents"}->[$i] = {};
$data{"pendingevents"}->[$i]->{"event"} = $ref->[1];
$data{"pendingevents"}->[$i]->{"time"} = $ref->[0] + 0;
if ($intcontexts) {
$data{"pendingevents"}->[$i]->{"context"} = $ref->[2];
}
++$i;
}
# content of pattern match cache
$data{"pmatchcache"} = \%pmatch_cache;
# list of active event correlation operations
$data{"operations"} = {};
while (($key, $ref) = each(%corr_list)) {
$data{"operations"}->{$key} = {};
convert_operation($data{"operations"}->{$key}, $key, $ref);
}
# list of active contexts
$i = 0;
%reported_names = ();
$data{"contexts"} = [];
while (($key, $ref) = each(%context_list)) {
if (exists($reported_names{$key})) { next; }
$data{"contexts"}->[$i]->{"name"} = [ keys %{$ref->{"Aliases"}} ];
foreach $name (keys %{$ref->{"Aliases"}}) {
$reported_names{$name} = 1;
}
$data{"contexts"}->[$i]->{"creationtime"} = $ref->{"Time"} + 0;
$data{"contexts"}->[$i]->{"lifetime"} = $ref->{"Window"} + 0;
if (scalar(@{$ref->{"Action"}})) {
$data{"contexts"}->[$i]->{"action"} = actionlist2str($ref->{"Action"});
}
$data{"contexts"}->[$i]->{"buffer"} = $ref->{"Buffer"};
++$i;
}
# list of running children
$data{"children"} = {};
while (($key, $ref) = each(%children)) {
$data{"children"}->{$key} = {};
$data{"children"}->{$key}->{"pid"} = $key + 0;
$data{"children"}->{$key}->{"cmdline"} = $ref->{"cmd"};
if ($ref->{"open"}) {
$data{"children"}->{$key}->{"status"} = "Connected to pipe input";
if ($intcontexts && exists($ref->{"context"}))
{ $data{"children"}->{$key}->{"context"} = $ref->{"context"}; }
}
}
# values of action list variables
$data{"variables"} = \%variables;
# The 'allow_unknown' option will convert unexpected values
# (such as code references held by action list variables) to json
# null values (without this option encode() will croak). Also,
# the 'utf8' option will generate json in utf8 format.
$json = eval { JSON::PP->new->utf8->allow_unknown->encode(\%data) };
if ($@) {
log_msg(LOG_ERR, "Can't create JSON data for dumpfile ($@)");
close($dhandle);
return;
}
if (defined($json)) { print $dhandle $json; }
close($dhandle);
log_msg(LOG_DEBUG, "Dump to $dfilename completed");
}
##############################################################
# Functions related to IO handling and input buffer management
##############################################################
# Parameters: par1 - reference to input buffer
# par2 - read-write pointer of input buffer
# Action: if the input buffer contains no data, initialize it;
# if its size has changed, rearrange buffer data and return
# the new read-write pointer
sub arrange_input_buffer {
my($buffer, $bufptr) = @_;
my($cursize, $i, $diff);
$cursize = scalar(@{$buffer});
# if the buffer length is zero, it needs initialization
if ($cursize == 0) {
for ($i = 0; $i < $bufsize; ++$i) { $buffer->[$i] = ""; }
return $bufsize - 1;
}
# if the buffer contains data and the buffer size has not changed,
# leave the buffer intact
if ($cursize == $bufsize) { return $bufptr; }
# if the buffer size has increased or decreased, shift the elements
# so that the earliest has index 0 and the latest (buffersize - 1)
@{$buffer} = @{$buffer}[$bufptr - $cursize + 1 .. $bufptr];
# if the buffer size has decreased by K, remove K earliest elements;
# if the buffer size has increased by K, add K elements
if ($cursize > $bufsize) {
$diff = $cursize - $bufsize;
for ($i = 0; $i < $diff; ++$i) { shift @{$buffer}; }
} else {
$diff = $bufsize - $cursize;
for ($i = 0; $i < $diff; ++$i) { unshift @{$buffer}, ""; }
}
return $bufsize - 1;
}
# Parameters: -
# Action: arrange all input buffers
sub arrange_input_buffers {
my($inputfile);
# create or resize the main input buffer and the list of input sources
# (they share a common read-write pointer, so it needs setting once)
arrange_input_buffer(\@input_buffer, $bufpos);
$bufpos = arrange_input_buffer(\@input_sources, $bufpos);
# with --jointbuf command line option, run SEC with joint input buffer
# for all input sources, otherwise set up separate buffers
if ($jointbuf) {
%input_buffers = ();
%event_buffer = ();
} else {
# create or resize the input buffer for synthetic events
if (!exists($event_buffer{"BufPos"})) {
$event_buffer{"Events"} = [];
$event_buffer{"BufPos"} = 0;
}
$event_buffer{"BufPos"} =
arrange_input_buffer($event_buffer{"Events"}, $event_buffer{"BufPos"});
# remove input buffers for sources which are no longer monitored
foreach $inputfile (keys %input_buffers) {
if (!exists($inputsrc{$inputfile})) { delete $input_buffers{$inputfile}; }
}
# create or resize the input buffer for each input source
foreach $inputfile (@inputfiles) {
if (!exists($input_buffers{$inputfile})) {
$input_buffers{$inputfile} = {};
$input_buffers{$inputfile}->{"Events"} = [];
$input_buffers{$inputfile}->{"BufPos"} = 0;
}
$input_buffers{$inputfile}->{"BufPos"} =
arrange_input_buffer($input_buffers{$inputfile}->{"Events"},
$input_buffers{$inputfile}->{"BufPos"});
}
}
}
# 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($conffile);
$intcontextname = SECEVENT_INT_CONTEXT;
log_msg(LOG_INFO, "Creating SEC internal context '$intcontextname'");
$int_context->{"Aliases"}->{$intcontextname} = 1;
$context_list{$intcontextname} = $int_context;
log_msg(LOG_INFO, "Creating SEC internal event '$text'");
$bufpos = ($bufpos + 1) % $bufsize;
$input_buffer[$bufpos] = $text;
$input_sources[$bufpos] = undef;
if (!$jointbuf) {
$event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize;
$event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $text;
}
%pmatch_cache = ();
foreach $conffile (@maincfiles) {
if (process_rules($conffile)) { last; }
}
++$processedlines;
log_msg(LOG_INFO, "Deleting SEC internal context '$intcontextname'");
delete $context_list{$intcontextname};
delete $int_context->{"Aliases"}->{$intcontextname};
$intcontextname = undef;
}
# Parameters: par1 - process ID
# par2 - 'read all' flag
# Action: read available data from the pipe of process par1 and create events
# from the data. If par2 is defined and non-zero, the function will
# keep reading until all available data have been consumed, otherwise
# the function will read once. The function will return the number
# bytes read from the pipe.
sub consume_pipe {
my($pid, $read_all) = @_;
my($rin, $ret, $pos, $nbytes, $total, $event);
$total = 0;
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;
} else { $total += $nbytes; }
# 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, $children{$pid}->{"context"};
}
if (!$read_all) { last; }
}
# 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, $children{$pid}->{"context"};
}
return $total;
}
# Parameters: -
# Action: check the status of SEC child processes, and read their standard
# output if the event buffer is empty (unprocessed data from an exited
# process will be appended to the event buffer unconditionally).
# If at least one child process returns some bytes, return 1 (even
# if these bytes do not constitute a full line), otherwise return 0
sub check_children {
my($pid, $exitcode, $newdata);
$newdata = 0;
# Check all child processes that have been started by '*spawn' actions
# for input data. If the buffer of synthetic events is not empty, polling
# of child processes is skipped. If new data from child standard output are
# available through pipe, create synthetic events from the data (provided
# that at least one complete line was read). If at least one child has
# new data, raise the 'newdata' flag (even if incomplete line was read).
if (!scalar(@events)) {
while ($pid = each(%children)) {
if ($children{$pid}->{"open"} && consume_pipe($pid)) { $newdata = 1; }
}
}
# 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 with the '*spawn' action and
# its pipe is still open, read all available data from the pipe
if ($children{$pid}->{"open"} && consume_pipe($pid, 1)) { $newdata = 1; }
# 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};
}
}
return $newdata;
}
# Parameters: par1 - reference to the socket hash table
# par2 - textual peer type
# Action: Check established connections in table par1 that holds TCP or unix
# stream sockets, in order to detect connections that have been closed
# by remote peers or have errors. Textual peer type par2 is used in
# log messages about connections that are closed or have errors.
sub check_established_conns {
my($sockets, $peertype) = @_;
my($peer, $ret, $buffer, $nbytes, $total);
# communication errors with peers are logged at the debug level,
# in order to prevent message floods with higher severity when large
# amounts of data are transfered
foreach $peer (keys %{$sockets}) {
$total = 0;
for (;;) {
# check if socket is ready for reading; if no data are available
# for reading, quit the read-loop
if (!socket_ready($sockets->{$peer}, 0)) { last; }
# if data are available, try to receive data from socket
$ret = recv($sockets->{$peer}, $buffer, $blocksize, 0);
$nbytes = length($buffer);
# if recv() failed because of the caught signal, try polling and
# receiving again; if recv() failed because of other error, close the
# socket and quit the read-loop; if recv() returned 0, it indicates
# EOF (connection has been closed), so close the socket;
# otherwise stop receiving if more than threshold bytes have been read
if (!defined($ret)) {
if ($! == EINTR) { next; }
log_msg(LOG_DEBUG, "Connection error to $peertype '$peer' ($!)");
delete $sockets->{$peer};
last;
}
elsif ($nbytes == 0) {
log_msg(LOG_DEBUG, "Connection to $peertype '$peer' closed by peer");
delete $sockets->{$peer};
last;
}
else { $total += $nbytes; }
if ($total >= BATCHREADLIMIT) { last; }
}
}
}
# Parameters: par1 - name of the input file
# par2 - file offset
# Action: Input file will be opened and file offset will be moved to
# offset par2 (-1 means "seek EOF" and 0 means "don't seek at all").
# Return the filehandle, device ID, inode number, and file type flag
# for the input file if open succeeded; otherwise return 'undef'.
sub open_input_file {
my($file, $fpos) = @_;
my($input, $flags, $regfile, @stat);
# 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 in the mode specified with
# the -rwfifo option (read-write or read-only nonblocking)
elsif (-p $file) {
if ($WIN32) {
log_msg(LOG_ERR, "Named pipe is not supported as input on Win32");
return undef;
}
if ($rwfifo) { $flags = O_RDWR; } else { $flags = O_RDONLY | O_NONBLOCK; }
while (!sysopen($input, $file, $flags)) {
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 a warning message
elsif (! -e $file) {
if ($reopen_timeout) {
log_msg(LOG_DEBUG, "Input file $file has not been created yet");
} else {
log_msg(LOG_WARN, "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 the input is not standard input, find the device id and inode number
# for the opened filehandle
if ($file ne "-") {
for (;;) {
@stat = stat($input);
if (scalar(@stat)) { last; }
if ($! == EINTR) { next; }
log_msg(LOG_ERR, "Can't stat input file $file through filehandle ($!)");
close($input);
return undef;
}
} else { @stat = ("-", "-"); }
# If input filehandle is connected to a regular file, set the file type
# flag to 1. Also, if $fpos == -1 or $fpos > 0, seek the given offset
# in the file. If $fpos is greater than the file size, EOF will be seeked.
if (-f $input) {
if ($fpos > $stat[7]) {
log_msg(LOG_NOTICE,
"Offset $fpos beyond EOF, seeking EOF in input file $file");
$fpos = -1;
}
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 offset $fpos in input file $file ($!)");
close($input);
return undef;
}
}
$regfile = 1;
} else { $regfile = 0; }
return ($input, $stat[0], $stat[1], $regfile);
}
# Parameters: par1 - file offset
# par2 - flag (optional)
# 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 offset will be moved to
# offset par1 (-1 means "seek EOF" and 0 means "don't seek at all").
# If -intcontexts option is active, also set up internal contexts.
# If flag par2 is set, input files which are already open will not
# be closed and reopened, and their status data will be retained
# (par2 reflects the value of the -keepopen command line option)
sub open_input {
my($fpos, $softopen) = @_;
my($filepat, $pattern, $cmdline_context);
my(%fcont, $inputfile, $time);
my($fh, $dev, $inode, $regfile, $i, $j, @buf);
# If $softopen is set, status data of already open input files must be
# retained and files must be kept open (note that $softopen reflects
# the value of the -keepopen command line option)
# In the case of full open, clean global arrays %inputsrc and @readbuffer
# (the keys for %inputsrc are members of global array @inputfiles).
# Note that dropping all data in %inputsrc will implicitly close all input
# file handles.
if (!$softopen) {
%inputsrc = ();
@readbuffer = ();
}
# Find the input file names and file contexts
%fcont = ();
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 store file-context pairs into %fcont
# (if a file is given more than once in the command line, the last
# definition will override previous ones)
foreach $inputfile (glob($pattern)) {
$fcont{$inputfile} = defined($cmdline_context)?$cmdline_context:
(FILEVENT_INT_CONTEXT_PREF . $inputfile);
}
}
# Merge dynamic input files with input files provided in command line
foreach $inputfile (keys %dyninputfiles) {
if (exists($fcont{$inputfile})) {
log_msg(LOG_NOTICE, "Dynamic input file", $inputfile,
"has been provided in command line and is no longer regarded dynamic");
delete $dyninputfiles{$inputfile};
} else {
$fcont{$inputfile} = $dyninputfiles{$inputfile};
}
}
# Open the input files
@inputfiles = sort keys %fcont;
$time = time();
foreach $inputfile (@inputfiles) {
log_msg(LOG_NOTICE, "Opening input file $inputfile");
# in the case of soft open, check if we already have status data
# for the input file in memory; if the file is open, update the file
# context, but retain all other status data and skip the open
if ($softopen && exists($inputsrc{$inputfile}) &&
$inputsrc{$inputfile}->{"open"}) {
log_msg(LOG_DEBUG, "Input file $inputfile already open");
$inputsrc{$inputfile}->{"context"} = $fcont{$inputfile};
next;
}
# in all other cases reopen the input file and (re)initialize its
# status data; note that if the file was previously open, recreating
# its entry in %inputsrc will close the previous file handle implicitly,
# since it is no longer referenced
($fh, $dev, $inode, $regfile) = open_input_file($inputfile, $fpos);
$inputsrc{$inputfile} = { "fh" => $fh,
"open" => defined($fh),
"dev" => $dev,
"inode" => $inode,
"regfile" => $regfile,
"buffer" => "",
"scriptexec" => 0,
"checktime" => 0,
"lastopen" => $time,
"lastread" => $time,
"lines" => 0,
"context" => $fcont{$inputfile} };
# if the input file open failed because of the missing file, set the
# "read_from_start" flag which enforces reading from the beginning
# when the file will appear and another open will be attempted
if (!defined($fh) && $inputfile ne "-" && ! -e $inputfile) {
$inputsrc{$inputfile}->{"read_from_start"} = 1;
}
}
# In the case of soft open, delete %inputsrc and @readbuffer entries for
# past input files which no longer match any input file pattern.
# This step does not need to be carried out for full open, since %inputsrc
# and @readbuffer are cleared before open. Note that deleting entries for
# past input files will implicitly close all open file handles for them.
if ($softopen) {
foreach $inputfile (keys %inputsrc) {
if (!exists($fcont{$inputfile})) { delete $inputsrc{$inputfile}; }
}
@buf = ();
$j = scalar(@readbuffer);
for ($i = 0; $i < $j; $i += 2) {
if (!exists($fcont{$readbuffer[$i+1]})) { next; }
push @buf, $readbuffer[$i], $readbuffer[$i+1];
}
@readbuffer = @buf;
}
}
# 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 call on the input file fails,
# close the file and return undef.
sub input_shuffled {
my($file) = $_[0];
my(@stat, @stat2, $fpos, $bytes);
# standard input is always intact (it can't be recreated or truncated)
if ($file eq "-") { return 0; }
# 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)
@stat = stat($file);
if (!scalar(@stat)) { return 0; }
# if the input file is a regular file, get the current read offset
if ($inputsrc{$file}->{"regfile"}) {
for (;;) {
$fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
if (defined($fpos)) { last; }
if ($! == EINTR) { next; }
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;
}
}
# Check if device or inode numbers of filehandle and input file match
# (this check will be skipped on Windows). If numbers don't match and
# filehandle refers to a regular file, find the size of the file and if
# read offset is smaller, read remaining bytes into file's IO buffer.
if (!$WIN32 &&
($inputsrc{$file}->{"dev"} != $stat[0] ||
$inputsrc{$file}->{"inode"} != $stat[1])) {
if ($inputsrc{$file}->{"regfile"}) {
@stat2 = stat($inputsrc{$file}->{"fh"});
if (scalar(@stat2)) {
$bytes = $stat2[7] - $fpos;
} else {
$bytes = 0;
}
if ($bytes > 0) {
sysread($inputsrc{$file}->{"fh"}, $inputsrc{$file}->{"buffer"},
$bytes, length($inputsrc{$file}->{"buffer"}));
}
}
log_msg(LOG_NOTICE, "Input file $file has been recreated");
return 1;
}
# If input file is a regular file, check if file size has decreased
if ($inputsrc{$file}->{"regfile"} && $fpos > $stat[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 ($inputsrc{$file}->{"regfile"}) {
# 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(); if pipe contains
# no data or polling yields an error, return undef
$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 pipe $file select error ($!), closing the pipe");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
} elsif ($ret == 0) { 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 pipe $file IO error ($!), closing the pipe");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
return undef;
}
} elsif ($nbytes == 0) {
# If sysread() returns 0, there are no writers on the pipe anymore,
# and from now on select() always claims that EOF is available for
# reading (in -rwfifo mode, this should never happen for a named pipe,
# since there is always at least one writer on the pipe).
# If the pipe is a named pipe and -tail mode is active, reopen the pipe;
# if the pipe represents standard input or -notail mode is active, close
# the pipe. If the file buffer is not empty, return its content (bytes
# between the last newline in the file and EOF), otherwise return undef.
# Log messages about close and reopen at the debug level, in order to
# prevent message floods when writer closes the pipe after each write.
log_msg(LOG_DEBUG, "No writers on input pipe $file, closing the pipe");
close($inputsrc{$file}->{"fh"});
$inputsrc{$file}->{"open"} = 0;
if ($tail && $file ne "-") {
log_msg(LOG_DEBUG, "Reopening input pipe $file");
($inputsrc{$file}->{"fh"},
$inputsrc{$file}->{"dev"},
$inputsrc{$file}->{"inode"},
$inputsrc{$file}->{"regfile"}) = open_input_file($file, -1);
$inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});
if ($reopen_timeout) { $inputsrc{$file}->{"lastopen"} = time(); }
}
$line = $inputsrc{$file}->{"buffer"};
$inputsrc{$file}->{"buffer"} = "";
if (length($line)) { return $line; } else { 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, $file;
if ($input_timeout) { $inputsrc{$file}->{"lastread"} = $time; }
if ($inputsrc{$file}->{"scriptexec"}) {
log_msg(LOG_INFO,
"Input received, executing script $timeout_script 0 $file");
exec_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 -check_timeout is set, poll the file after $check_timeout seconds
if ($check_timeout) {
$inputsrc{$file}->{"checktime"} = $time + $check_timeout;
}
# 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");
exec_cmd([$timeout_script, 1, $file]);
$inputsrc{$file}->{"scriptexec"} = 1;
}
# if there were no new bytes in the input file and -notail mode
# is active, skip shuffle and reopen timeout checks
if (!$tail) { next; }
# 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, "Reopening $file and processing from the start");
close($inputsrc{$file}->{"fh"});
($inputsrc{$file}->{"fh"},
$inputsrc{$file}->{"dev"},
$inputsrc{$file}->{"inode"},
$inputsrc{$file}->{"regfile"}) = 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 $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"},
$inputsrc{$file}->{"dev"},
$inputsrc{$file}->{"inode"},
$inputsrc{$file}->{"regfile"}) = open_input_file($file, 0);
if (defined($inputsrc{$file}->{"fh"})) {
delete $inputsrc{$file}->{"read_from_start"};
}
} else {
($inputsrc{$file}->{"fh"},
$inputsrc{$file}->{"dev"},
$inputsrc{$file}->{"inode"},
$inputsrc{$file}->{"regfile"}) = 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;
}
}
# Parameters: -
# Action: close all output files and sockets, and drop related data structures
# (dropping all filehandles from memory forces them to be closed)
sub close_outputs {
%output_files = ();
%output_udgram = ();
%output_ustrconn = ();
%output_ustream = ();
%output_udpsock = ();
%output_tcpconn = ();
%output_tcpsock = ();
}
###################################################
# Functions related to signal reception and sending
###################################################
# Parameters: -
# Action: check whether signals have arrived and process them
sub check_signals {
my($file, @file_list, @keys, $templevel);
# if SIGHUP has arrived, do a full restart of SEC
if ($refresh) {
log_msg(LOG_NOTICE, "SIGHUP received: full restart of SEC");
# if -intevents flag was specified, generate the SEC_PRE_RESTART event
if ($intevents) { internal_event("SEC_PRE_RESTART"); }
# close all output files and sockets
close_outputs();
# terminate child processes
if ($childterm) { child_cleanup(); }
# clear correlation operations, contexts and action list variables
%corr_list = ();
%context_list = ();
%variables = ();
# clear pending events
@pending_events = ();
# drop the names of dynamic input files (they will be closed when
# open_input() is called later in this function)
%dyninputfiles = ();
# close the logfile and connection to the system logger
if ($logopen) { close($loghandle); $logopen = 0; }
if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }
# re-read SEC command line and resource file options
read_options();
# open the logfile and connection to the system logger
if (defined($logfile)) { open_logfile($logfile); }
if (defined($syslogf)) { open_syslog($syslogf); }
# read configuration from SEC rule files
read_config();
# if --bufsize command line option has not been provided or --bufsize=0,
# set --bufsize by analyzing loaded rules
if (!$bufsize) { set_bufsize_option(); }
# (re)open all input sources and arrange input buffers
open_input(-1);
arrange_input_buffers();
# since all action list variables have been dropped, re-create builtin
# action list variables for the current second and special characters
$timevar_update = time();
set_actionlist_time_var($timevar_update);
set_actionlist_char_var();
# 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");
# if -intevents flag was specified, generate the SEC_PRE_SOFTRESTART event
if ($intevents) { internal_event("SEC_PRE_SOFTRESTART"); }
# close all output files and sockets
close_outputs();
# close the logfile and connection to the system logger
if ($logopen) { close($loghandle); $logopen = 0; }
if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }
# re-read SEC command line and resource file options
read_options();
# open the logfile and connection to the system logger
if (defined($logfile)) { open_logfile($logfile); }
if (defined($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);
# if --bufsize command line option has not been provided or --bufsize=0,
# set --bufsize by analyzing loaded rules
if (!$bufsize) { set_bufsize_option(); }
# clear event correlation operations related to the modified and
# removed configuration files
foreach $file (@file_list) {
@keys = grep($corr_list{$_}->{"File"} eq $file, keys %corr_list);
log_msg(LOG_DEBUG,
"Terminating all event correlation operations started from $file,",
"number of operations:", scalar(@keys));
delete @corr_list{@keys};
}
# if -keepopen flag was specified, close old and open new input sources,
# otherwise (re)open all input sources; also, arrange input buffers
open_input(-1, $keepopen);
arrange_input_buffers();
# 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 performance and debug data");
# write info about SEC state to the dump file
if ($dumpfjson) { dump_data_json(); } else { 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: closing outputs and restarting logging");
# if -intevents flag was specified, generate the SEC_PRE_LOGROTATE event
if ($intevents) { internal_event("SEC_PRE_LOGROTATE"); }
# close all output files and sockets
close_outputs();
# reopen the logfile and connection to the system logger
if ($logopen) { close($loghandle); $logopen = 0; }
if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }
if (defined($logfile)) { open_logfile($logfile); }
if (defined($syslogf)) { open_syslog($syslogf); }
# if -intevents flag was specified, generate the SEC_LOGROTATE event
if ($intevents) { internal_event("SEC_LOGROTATE"); }
# set the signal flag back to zero
$openlog = 0;
}
# if SIGINT has arrived, set the debug level to a new value; also, log
# a message without level, so that it would always appear in the log
if ($debuglevelinc) {
$templevel = ($debuglevel + $debuglevelinc - 1) % 6 + 1;
log_msg(LOG_WITHOUT_LEVEL, $debuglevelinc, "SIGINT signal(s) received:",
"setting debuglevel from $debuglevel to $templevel");
$debuglevel = $templevel;
# set the signal counter back to zero
$debuglevelinc = 0;
}
# if SIGTERM has arrived, shutdown SEC
if (exists($terminate{$$})) {
log_msg(LOG_NOTICE, "SIGTERM received: shutting down SEC");
# If -intevents flag was specified, generate the SEC_SHUTDOWN event.
# 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");
if ($childterm) { sleep(TERMTIMEOUT); }
}
# final shutdown procedures
if ($childterm) { child_cleanup(); }
exit(0);
}
}
# Parameters: -
# Action: detect if SIGINT can be used for changing logging levels
sub override_sigint {
my($tty, $fh, $tcpgrp, $pgrp);
# if the process is started as a daemon, override SIGINT
if ($detach) { return 1; }
# on Windows platform, do not override SIGINT
if ($WIN32) { return 0; }
# if the process was not started as a daemon, get the name of the special
# file which points to the controlling terminal of the process (should be
# /dev/tty on most platforms); if opening the special file fails, the
# process has no controlling terminal, and override SIGINT
$tty = POSIX::ctermid();
if (!open($fh, $tty)) { return 1; }
# get group ID of the current process, and the group ID of the foreground
# process at the controlling terminal; if the ID's are different, current
# process is not running on foreground, and override SIGINT
$pgrp = POSIX::getpgrp();
if (!defined($pgrp)) {
log_msg(LOG_ERR, "Can't get process group ID ($!)");
return 0;
}
$tcpgrp = POSIX::tcgetpgrp(fileno($fh));
if (!defined($tcpgrp)) {
log_msg(LOG_ERR, "Can't get foreground process group ID ($!)");
return 0;
}
close($fh);
return ($pgrp != $tcpgrp);
}
# Parameters: -
# Action: terminate child processes
sub child_cleanup {
my($pid, $p);
while($pid = each(%children)) {
$p = waitpid($pid, WNOHANG);
# exit status of a terminated process has been already fetched with waitpid(),
# but the process is still present in the %children hash (should never happen)
if ($p == -1) {
delete $children{$pid};
next;
}
# according to the current call to waitpid(), the process has terminated
if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) {
delete $children{$pid};
next;
}
# the process is running
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;
$sigreceived = 1;
}
# Parameters: -
# Action: on arrival of SIGABRT set flag $softrefresh
sub abrt_handler {
$SIG{ABRT} = \&abrt_handler;
$softrefresh = 1;
$sigreceived = 1;
}
# Parameters: -
# Action: on arrival of SIGUSR1 set flag $dumpdata
sub usr1_handler {
$SIG{USR1} = \&usr1_handler;
$dumpdata = 1;
$sigreceived = 1;
}
# Parameters: -
# Action: on arrival of SIGUSR2 set flag $openlog
sub usr2_handler {
$SIG{USR2} = \&usr2_handler;
$openlog = 1;
$sigreceived = 1;
}
# Parameters: -
# Action: on arrival of SIGINT set flag $debuglevelinc
sub int_handler {
$SIG{INT} = \&int_handler;
++$debuglevelinc;
$sigreceived = 1;
}
# Parameters: -
# Action: on arrival of SIGTERM set a flag for the current process ID
sub term_handler {
$SIG{TERM} = \&term_handler;
$terminate{$$} = 1;
$sigreceived = 1;
}
########################################################
# Functions related to daemonization, pid file creation,
# setting the user and group ID, 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: create the pid file for the process
sub create_pidfile {
my($file) = $_[0];
my($fh);
if (open($fh, ">$file")) {
print $fh "$$\n";
close($fh);
} else {
log_msg(LOG_CRIT, "Can't open pidfile $file for writing ($!), exiting!");
exit(1);
}
}
# Parameters: par1 - effective group ID
# par2, par3, .. - IDs of supplementary groups
# Action: set effective group ID to par1 and supplementary groups to
# par1, par2, par3, etc. Return 1 if supplementary groups were
# successfully set, 0 otherwise.
sub set_supplementary_groups {
my($egid) = $_[0];
my(@supp_gids) = @_;
my(%gids, %result, @list, $gid);
# since perl POSIX module lacks setgroups(), set the $) special variable
# accordingly (the first element in the string must be effective group ID,
# while the following elements define supplementary groups)
$) = "$egid " . join(" ", @supp_gids);
# to verify if setting supplementary groups succeeded, check $) variable
# (note that $) can report the same supplementary group ID more than once)
@list = split(' ', $) );
# if effective group ID is not properly set, setting the groups has failed
if ($egid != $list[0]) { return 0; }
# since POSIX leaves it open whether effective group ID is reported in
# the list of supplementary groups, create %result from all gids in $)
%gids = map { $_ => 1 } @supp_gids;
%result = map { $_ => 1 } @list;
# verify that all requested groups are among supplementary groups
foreach $gid (keys %gids) {
if (!exists($result{$gid})) { return 0; }
delete $result{$gid};
}
# verify that other groups are not among supplementary groups
if (scalar(%result)) { return 0; }
return 1;
}
# Parameters: -
# Action: set the user and group ID, and exit if an error is encountered.
# This function logs its error messages to standard error, since
# the logfile has to be opened after a call to this function with
# a new user and group ID.
sub set_user_and_group_id {
my($userid, $groupid, $groupname, $gname, $gid);
my(@pwinfo, %supp_gids);
# --user and --group options are not supported on Windows
if ($WIN32) {
print STDERR "'--user' and '--group' options are not supported on Win32\n";
exit(1);
}
# --user and --group options can be used if process is running with euid 0
if ($>) {
print STDERR "'--user' and '--group' options can only be used by root " .
"(current euid is not 0 but $>)\n";
exit(1);
}
# find numerical ID for the user name provided with --user option
@pwinfo = getpwnam($username);
if (!scalar(@pwinfo)) {
print STDERR "User name '$username' does not exist, exiting!\n";
exit(1);
}
$userid = $pwinfo[2];
if (!$userid) {
print STDERR
"Can't drop root privileges by setting user to '$username', exiting!\n";
exit(1);
}
# Find numerical IDs for group names provided with --group options.
# If several --group options were provided, the first group defines the
# group ID. If no --group option was provided, group ID is set to the user's
# primary group. Also, each group is treated as a supplementary group.
%supp_gids = ();
if (scalar(@groupnames)) {
foreach $gname (@groupnames) {
$gid = getgrnam($gname);
if (!defined($gid)) {
print STDERR "Group name '$gname' does not exist, exiting!\n";
exit(1);
}
if (!scalar(%supp_gids)) {
$groupname = $gname;
$groupid = $gid;
}
$supp_gids{$gid} = $gname;
}
} else {
$groupid = $pwinfo[3];
$groupname = getgrgid($groupid);
if (!defined($groupname)) {
print STDERR "Group ID '$groupid' does not exist, exiting!\n";
exit(1);
}
$supp_gids{$groupid} = $groupname;
}
# Set the group ID with setgid(). This must be done before changing
# the user ID, since otherwise there might not be enough privileges for
# successful setgid() call. Although setgid() behavior depends on
# the platform (e.g., behavior on BSD and Linux is different), it always
# sets the effective, real, and saved set-group ID if effective user ID
# is 0 (verified above). Also note that some ancient versions of perl do
# not return 'undef' if setgid() fails but rather the value of the $)
# special variable. Therefore, we also check if both effective and real
# group ID are properly set after setgid() has been called (the IDs are
# first elements in strings provided by $) and $( variables).
if (!POSIX::setgid($groupid) || (split(' ', $) ))[0] != $groupid
|| (split(' ', $( ))[0] != $groupid) {
print STDERR "Can't set group to '$groupname' ($!), exiting!\n";
exit(1);
}
# set supplementary groups (this must be done before changing the user ID,
# since otherwise there might not be enough privileges for that)
if (!set_supplementary_groups($groupid, keys %supp_gids)) {
print STDERR "Can't set supplementary groups to '" .
join(" ", values %supp_gids) . "', exiting!\n";
exit(1);
}
# Set the user ID with setuid(). Although setuid() behavior depends on
# the platform (e.g., behavior on BSD and Linux is different), it always
# sets the effective, real, and saved set-user ID if effective user ID
# is 0 (verified above). Also note that some ancient versions of perl do
# not return 'undef' if setuid() fails but rather the value of the $>
# special variable. Therefore, we also check if both effective and real
# user ID ($> and $<) are properly set after setuid() has been called.
if (!POSIX::setuid($userid) || $> != $userid || $< != $userid) {
print STDERR "Can't set user to '$username' ($!), exiting!\n";
exit(1);
}
}
# Parameters: -
# Action: Set the file mode creation mask (if the current platform does
# not support umask(2) system call, umask() returns undef).
# This function logs its error messages to standard error, since
# the logfile has to be opened after a call to this function with
# a new umask.
sub set_umask {
if (!defined(umask($umask))) {
print STDERR "'--umask' option is not supported on this platform\n";
exit(1);
}
}
# Parameters: -
# Action: scan all rules loaded from configuration files, and set the
# --bufsize command line option to the largest number of lines
# configured with the ptype* field (e.g., if loaded rules have
# fields ptype=RegExp2, ptype2=PerlFunc5, ptype=RegExp3, and
# ptype=NSubStr4, assume --bufsize=5).
sub set_bufsize_option {
my($conffile, $rule);
my($type, $max, $i);
# the function will always set --bufsize to at least 1, even if
# no valid rules have been defined in configuration files
$max = 1;
# scan all loaded rules for finding the value for --bufsize
foreach $conffile (@conffiles) {
foreach $rule (@{$configuration{$conffile}}) {
$type = $rule->{"Type"};
if ($type == CALENDAR) { next; }
elsif ($type == SINGLE || $type == SINGLE_W_SUPPRESS ||
$type == SINGLE_W_SCRIPT || $type == SINGLE_W_THRESHOLD ||
$type == SINGLE_W_2_THRESHOLDS || $type == SUPPRESS ||
$type == JUMP) {
if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; }
}
elsif ($type == PAIR || $type == PAIR_W_WINDOW) {
if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; }
if ($max < $rule->{"PatLines2"}) { $max = $rule->{"PatLines2"}; }
}
elsif ($type == EVENT_GROUP) {
foreach $i (@{$rule->{"PatLinesList"}}) {
if ($max < $i) { $max = $i; }
}
}
}
}
log_msg(LOG_DEBUG, "No --bufsize command line option or --bufsize=0,",
"setting --bufsize to $max");
$bufsize = $max;
# in the case of --bufsize=1, always enable the --jointbuf option,
# since there is no need to maintain multiple input buffers
if ($bufsize == 1) { $jointbuf = 1; }
}
# Parameters: -
# Action: read and process options from command line and resource file
# (this function logs its error messages to standard error, since
# logging is not activated when the function is called)
sub read_options {
my(@argv_backup, @values, $option, $fh);
# 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($fh, $ENV{"SECRC"})) {
while (<$fh>) {
if (/^\s*(.*\S)/) {
$option = $1;
if (index($option, '#') == 0) { next; }
push @ARGV, $option;
}
}
close($fh);
$rcfile_status = $ENV{"SECRC"};
} else {
print STDERR "Can't open resource file " . $ENV{"SECRC"} . " ($!)\n";
$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 = undef;
$reopen_timeout = 0;
$check_timeout = 0;
$poll_timeout = DEFAULT_POLLTIMEOUT;
$socket_timeout = DEFAULT_SOCKETTIMEOUT;
$blocksize = DEFAULT_BLOCKSIZE;
$bufsize = 0;
$evstoresize = 0;
$cleantime = DEFAULT_CLEANTIME;
$logfile = undef;
$syslogf = undef;
$debuglevel = 6;
$pidfile = undef;
$dumpfile = DEFAULT_DUMPFILE;
$username = undef;
@groupnames = ();
$umask = undef;
$ruleperf = 0;
$dumpfts = 0;
$dumpfjson = 0;
$quoting = 0;
$tail = 1;
$fromstart = 0;
$detach = 0;
$jointbuf = 0;
$keepopen = 1;
$rwfifo = 1;
$childterm = 1;
$intevents = 0;
$intcontexts = 0;
$testonly = 0;
$help = 0;
$version = 0;
# parse the options given in command line and in SEC resource file
# (GetOptions() prints parsing error messages to standard error)
GetOptions( "conf=s" => \@conffilepat,
"input=s" => \@inputfilepat,
"input-timeout|input_timeout=i" => \$input_timeout,
"timeout-script|timeout_script=s" => \$timeout_script,
"reopen-timeout|reopen_timeout=i" => \$reopen_timeout,
"check-timeout|check_timeout=i" => \$check_timeout,
"poll-timeout|poll_timeout=f" => \$poll_timeout,
"socket-timeout|socket_timeout=i" => \$socket_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,
"user=s" => \$username,
"group=s" => \@groupnames,
"umask=o" => \$umask,
"ruleperf!" => \$ruleperf,
"dumpfts!" => \$dumpfts,
"dumpfjson!" => \$dumpfjson,
"quoting!" => \$quoting,
"tail!" => \$tail,
"fromstart!" => \$fromstart,
"detach!" => \$detach,
"jointbuf!" => \$jointbuf,
"keepopen!" => \$keepopen,
"rwfifo!" => \$rwfifo,
"childterm!" => \$childterm,
"intevents!" => \$intevents,
"intcontexts!" => \$intcontexts,
"testonly!" => \$testonly,
"help|?" => \$help,
"version" => \$version,
"<>" => sub { print STDERR "Unknown argument: $_[0]\n"; } );
# check the values received from command line and resource file
# and set option variables back to defaults, if necessary
@values = grep(length($_), @conffilepat);
if (scalar(@values) < scalar(@conffilepat)) {
print STDERR "'--conf' option requires a non-empty value\n";
@conffilepat = @values;
}
@values = grep(length($_), @inputfilepat);
if (scalar(@values) < scalar(@inputfilepat)) {
print STDERR "'--input' option requires a non-empty value\n";
@inputfilepat = @values;
}
if ($input_timeout < 0) {
print STDERR "'--input-timeout' option requires a non-negative value\n";
$input_timeout = 0;
}
if (defined($timeout_script) && !length($timeout_script)) {
print STDERR "'--timeout-script' option requires a non-empty value\n";
$timeout_script = undef;
}
if ($input_timeout > 0 && !defined($timeout_script)) {
print STDERR
"'--input-timeout' option requires the '--timeout-script' option\n";
$input_timeout = 0;
}
if ($reopen_timeout < 0) {
print STDERR "'--reopen-timeout' option requires a non-negative value\n";
$reopen_timeout = 0;
}
if ($check_timeout < 0) {
print STDERR "'--check-timeout' option requires a non-negative value\n";
$check_timeout = 0;
}
if ($poll_timeout < 0) {
print STDERR "'--poll-timeout' option requires a non-negative value\n";
$poll_timeout = DEFAULT_POLLTIMEOUT;
}
if ($socket_timeout <= 0) {
print STDERR "'--socket-timeout' option requires a positive value\n";
$socket_timeout = DEFAULT_SOCKETTIMEOUT;
}
if ($blocksize <= 0) {
print STDERR "'--blocksize' option requires a positive value\n";
$blocksize = DEFAULT_BLOCKSIZE;
}
if ($bufsize < 0) {
print STDERR "'--bufsize' option requires a non-negative value\n";
$bufsize = 0;
}
if ($evstoresize < 0) {
print STDERR "'--evstoresize' option requires a non-negative value\n";
$evstoresize = 0;
}
if ($cleantime < 0) {
print STDERR "'--cleantime' option requires a non-negative value\n";
$cleantime = DEFAULT_CLEANTIME;
}
if (defined($logfile) && !length($logfile)) {
print STDERR "'--log' option requires a non-empty value\n";
$logfile = undef;
}
if (defined($syslogf) && !$SYSLOGAVAIL) {
print STDERR "'--syslog' option requires Perl Sys::Syslog module\n";
$syslogf = undef;
}
if (defined($syslogf) && !length($syslogf)) {
print STDERR "'--syslog' option requires a non-empty value\n";
$syslogf = undef;
}
if ($debuglevel < 1 || $debuglevel > 6) {
print STDERR "'--debug' option requires a value from range 1..6\n";
$debuglevel = 6;
}
if (defined($pidfile) && !length($pidfile)) {
print STDERR "'--pid' option requires a non-empty value\n";
$pidfile = undef;
}
if (!length($dumpfile)) {
print STDERR "'--dump' option requires a non-empty value\n";
$dumpfile = DEFAULT_DUMPFILE;
}
if (defined($username) && !length($username)) {
print STDERR "'--user' option requires a non-empty value\n";
$username = undef;
}
@values = grep(length($_), @groupnames);
if (scalar(@values) < scalar(@groupnames)) {
print STDERR "'--group' option requires a non-empty value\n";
@groupnames = @values;
}
if (scalar(@groupnames) && !defined($username)) {
print STDERR "'--group' option requires the '--user' option\n";
@groupnames = ();
}
if (defined($umask) && ($umask < 0 || $umask > 511)) {
print STDERR "'--umask' option requires a value from range 0..0777\n";
$umask = undef;
}
if ($dumpfjson && !$JSONAVAIL) {
print STDERR "'--dumpfjson' option requires Perl JSON::PP module\n";
$dumpfjson = 0;
}
# in the case of --bufsize=1, always enable the --jointbuf option,
# since there is no need to maintain multiple input buffers
if ($bufsize == 1) { $jointbuf = 1; }
# restore the @ARGV array
@ARGV = @argv_backup;
}
############################
# Function for the main loop
############################
# Parameters: -
# Action: the main loop - receive events from inputs and process them
sub main_loop {
my($line, $evcont, $file);
my($conffile, $childdata);
for (;;) {
# check the status of child processes, and poll them for new events if
# the event buffer is empty (if a process has exited, all its remaining
# events are read and appended to event buffer even if it is not empty)
if (scalar(%children)) {
$childdata = check_children();
} else {
$childdata = 0;
}
# 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;
$evcont = shift @events;
$file = undef;
} elsif (scalar(@readbuffer)) {
$line = shift @readbuffer;
$file = shift @readbuffer;
} else {
read_line($line, $file);
}
if (defined($line)) {
# with --intcontexts option, set up internal context and store its
# name to $intcontextname global variable (this variable will be used
# for setting the $+{_intcontext} match variable)
if ($intcontexts) {
$intcontextname = defined($file)?$inputsrc{$file}->{"context"}:$evcont;
$int_context->{"Aliases"}->{$intcontextname} = 1;
$context_list{$intcontextname} = $int_context;
}
# update input buffers (they are implemented as circular buffers, since
# according to benchmarks an array queue using shift and push is slower)
# note that joint buffer is also maintained during --nojointbuf mode,
# since @input_sources list is used for pattern matching purposes
$bufpos = ($bufpos + 1) % $bufsize;
$input_buffer[$bufpos] = $line;
$input_sources[$bufpos] = $file;
if (!$jointbuf) {
if (defined($file)) {
$input_buffers{$file}->{"BufPos"} = ($input_buffers{$file}->{"BufPos"} + 1) % $bufsize;
$input_buffers{$file}->{"Events"}->[$input_buffers{$file}->{"BufPos"}] = $line;
} else {
$event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize;
$event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $line;
}
}
# clear pattern match cache
%pmatch_cache = ();
# process rules from configuration files
foreach $conffile (@maincfiles) {
if (process_rules($conffile)) { last; }
}
# with --intcontexts option, drop previously created internal context
if ($intcontexts) {
delete $context_list{$intcontextname};
delete $int_context->{"Aliases"}->{$intcontextname};
$intcontextname = undef;
}
if (defined($file)) { ++$inputsrc{$file}->{"lines"}; }
++$processedlines;
} elsif (!$file) {
# if --notail mode is active and all input files have been closed, exit;
# if no new data was appended to input files, sleep with select(),
# unless some child process returned data during last polling round
if (!$tail && !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");
if ($childterm) { sleep(TERMTIMEOUT); }
}
if ($childterm) { child_cleanup(); }
exit(0);
}
# sleep if no new data were read from input files or child processes
if (!$childdata) { select(undef, undef, undef, $poll_timeout); }
}
# search lists for accomplishing timed tasks and removing obsolete elements
if (time() - $lastcleanuptime >= $cleantime) {
process_lists();
$lastcleanuptime = time();
}
# check signal flags
if ($sigreceived) {
check_signals();
$sigreceived = 0;
}
}
}
##################################################################
# ------------------------- MAIN PROGRAM -------------------------
##################################################################
### Set function pointers and create a template for internal contexts
$matchfunc[SUBSTR] = \&match_substr;
$matchfunc[REGEXP] = \&match_regexp;
$matchfunc[PERLFUNC] = \&match_perlfunc;
$matchfunc[CACHED] = \&match_cached;
$matchfunc[NSUBSTR] = \&match_nsubstr;
$matchfunc[NREGEXP] = \&match_nregexp;
$matchfunc[NPERLFUNC] = \&match_nperlfunc;
$matchfunc[NCACHED] = \&match_ncached;
$matchfunc[TVALUE] = \&match_tvalue;
$matchrulefunc[SINGLE] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_SCRIPT] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_SUPPRESS] = \&match_1pattern_rule;
$matchrulefunc[PAIR] = \&match_2pattern_rule;
$matchrulefunc[PAIR_W_WINDOW] = \&match_2pattern_rule;
$matchrulefunc[SINGLE_W_THRESHOLD] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_2_THRESHOLDS] = \&match_1pattern_rule;
$matchrulefunc[EVENT_GROUP] = \&match_eventgroup_rule;
$matchrulefunc[SUPPRESS] = \&match_1pattern_rule;
$matchrulefunc[JUMP] = \&match_1pattern_rule;
$matchegrpfunc[SUBSTR] = \&match_eventgroup_substr;
$matchegrpfunc[REGEXP] = \&match_eventgroup_regexp;
$matchegrpfunc[PERLFUNC] = \&match_eventgroup_perlfunc;
$matchegrpfunc[NSUBSTR] = \&match_eventgroup_nsubstr;
$matchegrpfunc[NREGEXP] = \&match_eventgroup_nregexp;
$matchegrpfunc[NPERLFUNC] = \&match_eventgroup_nperlfunc;
$processrulefunc[SINGLE] = \&process_single_rule;
$processrulefunc[SINGLE_W_SCRIPT] = \&process_singlewithscript_rule;
$processrulefunc[SINGLE_W_SUPPRESS] = \&process_singlewithsuppress_rule;
$processrulefunc[PAIR] = \&process_pair_rule;
$processrulefunc[PAIR_W_WINDOW] = \&process_pairwithwindow_rule;
$processrulefunc[SINGLE_W_THRESHOLD] = \&process_singlewiththreshold_rule;
$processrulefunc[SINGLE_W_2_THRESHOLDS] = \&process_singlewith2thresholds_rule;
$processrulefunc[EVENT_GROUP] = \&process_eventgroup_rule;
$processrulefunc[JUMP] = \&process_jump_rule;
$actioncopyfunc[NONE] = \©_one_elem_action;
$actioncopyfunc[LOGONLY] = \©_two_elem_action;
$actioncopyfunc[WRITE] = \©_three_elem_action;
$actioncopyfunc[WRITEN] = \©_three_elem_action;
$actioncopyfunc[CLOSEF] = \©_two_elem_action;
$actioncopyfunc[OWRITECL] = \©_three_elem_action;
$actioncopyfunc[UDGRAM] = \©_three_elem_action;
$actioncopyfunc[CLOSEUDGR] = \©_two_elem_action;
$actioncopyfunc[USTREAM] = \©_three_elem_action;
$actioncopyfunc[CLOSEUSTR] = \©_two_elem_action;
$actioncopyfunc[UDPSOCK] = \©_three_elem_action;
$actioncopyfunc[CLOSEUDP] = \©_two_elem_action;
$actioncopyfunc[TCPSOCK] = \©_three_elem_action;
$actioncopyfunc[CLOSETCP] = \©_two_elem_action;
$actioncopyfunc[SHELLCOMMAND] = \©_two_elem_action;
$actioncopyfunc[COMMANDEXEC] = \©_cmdexec_spawnexec_action;
$actioncopyfunc[SPAWN] = \©_two_elem_action;
$actioncopyfunc[SPAWNEXEC] = \©_cmdexec_spawnexec_action;
$actioncopyfunc[CSPAWN] = \©_three_elem_action;
$actioncopyfunc[CSPAWNEXEC] = \©_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[PIPE] = \©_three_elem_action;
$actioncopyfunc[PIPEEXEC] = \©_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[CREATECONTEXT] = \©_create_set_action;
$actioncopyfunc[DELETECONTEXT] = \©_two_elem_action;
$actioncopyfunc[OBSOLETECONTEXT] = \©_two_elem_action;
$actioncopyfunc[SETCONTEXT] = \©_create_set_action;
$actioncopyfunc[ALIAS] = \©_three_elem_action;
$actioncopyfunc[UNALIAS] = \©_two_elem_action;
$actioncopyfunc[ADD] = \©_three_elem_action;
$actioncopyfunc[PREPEND] = \©_three_elem_action;
$actioncopyfunc[FILL] = \©_three_elem_action;
$actioncopyfunc[REPORT] = \©_three_elem_action;
$actioncopyfunc[REPORTEXEC] = \©_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[COPYCONTEXT] = \©_three_elem_action;
$actioncopyfunc[EMPTYCONTEXT] = \©_three_elem_action;
$actioncopyfunc[POP] = \©_three_elem_action;
$actioncopyfunc[SHIFT] = \©_three_elem_action;
$actioncopyfunc[EXISTS] = \©_three_elem_action;
$actioncopyfunc[GETSIZE] = \©_three_elem_action;
$actioncopyfunc[GETALIASES] = \©_three_elem_action;
$actioncopyfunc[GETLIFETIME] = \©_three_elem_action;
$actioncopyfunc[SETLIFETIME] = \©_three_elem_action;
$actioncopyfunc[GETCTIME] = \©_three_elem_action;
$actioncopyfunc[SETCTIME] = \©_three_elem_action;
$actioncopyfunc[EVENT] = \©_three_elem_action;
$actioncopyfunc[TEVENT] = \©_three_elem_action;
$actioncopyfunc[CEVENT] = \©_four_elem_action;
$actioncopyfunc[RESET] = \©_four_elem_action;
$actioncopyfunc[GETWINPOS] = \©_five_elem_action;
$actioncopyfunc[SETWINPOS] = \©_five_elem_action;
$actioncopyfunc[ASSIGN] = \©_three_elem_action;
$actioncopyfunc[ASSIGNSQ] = \©_three_elem_action;
$actioncopyfunc[FREE] = \©_two_elem_action;
$actioncopyfunc[EVAL] = \©_three_elem_action;
$actioncopyfunc[CALL] = \©_call_action;
$actioncopyfunc[LCALL] = \©_lcall_action;
$actioncopyfunc[REWRITE] = \©_three_elem_action;
$actioncopyfunc[ADDINPUT] = \©_four_elem_action;
$actioncopyfunc[DROPINPUT] = \©_two_elem_action;
$actioncopyfunc[SIGEMUL] = \©_two_elem_action;
$actioncopyfunc[VARIABLESET] = \©_three_elem_action;
$actioncopyfunc[IF] = \©_if_action;
$actioncopyfunc[WHILE] = \©_while_action;
$actioncopyfunc[BREAK] = \©_one_elem_action;
$actioncopyfunc[CONTINUE] = \©_one_elem_action;
$actionsubstfunc[NONE] = \&subst_none_break_continue;
$actionsubstfunc[LOGONLY] = \&subst_two_elem_action;
$actionsubstfunc[WRITE] = \&subst_three_elem_action;
$actionsubstfunc[WRITEN] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEF] = \&subst_two_elem_action;
$actionsubstfunc[OWRITECL] = \&subst_three_elem_action;
$actionsubstfunc[UDGRAM] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUDGR] = \&subst_two_elem_action;
$actionsubstfunc[USTREAM] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUSTR] = \&subst_two_elem_action;
$actionsubstfunc[UDPSOCK] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUDP] = \&subst_two_elem_action;
$actionsubstfunc[TCPSOCK] = \&subst_three_elem_action;
$actionsubstfunc[CLOSETCP] = \&subst_two_elem_action;
$actionsubstfunc[SHELLCOMMAND] = \&subst_two_elem_action;
$actionsubstfunc[COMMANDEXEC] = \&subst_cmdexec_spawnexec_action;
$actionsubstfunc[SPAWN] = \&subst_two_elem_action;
$actionsubstfunc[SPAWNEXEC] = \&subst_cmdexec_spawnexec_action;
$actionsubstfunc[CSPAWN] = \&subst_three_elem_action;
$actionsubstfunc[CSPAWNEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[PIPE] = \&subst_three_elem_action;
$actionsubstfunc[PIPEEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[CREATECONTEXT] = \&subst_create_set_action;
$actionsubstfunc[DELETECONTEXT] = \&subst_two_elem_action;
$actionsubstfunc[OBSOLETECONTEXT] = \&subst_two_elem_action;
$actionsubstfunc[SETCONTEXT] = \&subst_create_set_action;
$actionsubstfunc[ALIAS] = \&subst_three_elem_action;
$actionsubstfunc[UNALIAS] = \&subst_two_elem_action;
$actionsubstfunc[ADD] = \&subst_three_elem_action;
$actionsubstfunc[PREPEND] = \&subst_three_elem_action;
$actionsubstfunc[FILL] = \&subst_three_elem_action;
$actionsubstfunc[REPORT] = \&subst_three_elem_action;
$actionsubstfunc[REPORTEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[COPYCONTEXT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[EMPTYCONTEXT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[POP] = \&subst_copy_empty_etc_action;
$actionsubstfunc[SHIFT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[EXISTS] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETSIZE] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETALIASES] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETLIFETIME] = \&subst_event_assign_etc_action;
$actionsubstfunc[SETLIFETIME] = \&subst_three_elem_action;
$actionsubstfunc[GETCTIME] = \&subst_event_assign_etc_action;
$actionsubstfunc[SETCTIME] = \&subst_three_elem_action;
$actionsubstfunc[EVENT] = \&subst_event_assign_etc_action;
$actionsubstfunc[TEVENT] = \&subst_three_elem_action;
$actionsubstfunc[CEVENT] = \&subst_four_elem_action;
$actionsubstfunc[RESET] = \&subst_reset_action;
$actionsubstfunc[GETWINPOS] = \&subst_getwpos_action;
$actionsubstfunc[SETWINPOS] = \&subst_setwpos_action;
$actionsubstfunc[ASSIGN] = \&subst_event_assign_etc_action;
$actionsubstfunc[ASSIGNSQ] = \&subst_event_assign_etc_action;
$actionsubstfunc[FREE] = \&subst_free;
$actionsubstfunc[EVAL] = \&subst_event_assign_etc_action;
$actionsubstfunc[CALL] = \&subst_call_action;
$actionsubstfunc[LCALL] = \&subst_lcall_action;
$actionsubstfunc[REWRITE] = \&subst_three_elem_action;
$actionsubstfunc[ADDINPUT] = \&subst_four_elem_action;
$actionsubstfunc[DROPINPUT] = \&subst_two_elem_action;
$actionsubstfunc[SIGEMUL] = \&subst_two_elem_action;
$actionsubstfunc[VARIABLESET] = \&subst_event_assign_etc_action;
$actionsubstfunc[IF] = \&subst_if_action;
$actionsubstfunc[WHILE] = \&subst_while_action;
$actionsubstfunc[BREAK] = \&subst_none_break_continue;
$actionsubstfunc[CONTINUE] = \&subst_none_break_continue;
$execactionfunc[NONE] = \&execute_none_action;
$execactionfunc[LOGONLY] = \&execute_logonly_action;
$execactionfunc[WRITE] = \&execute_write_action;
$execactionfunc[WRITEN] = \&execute_write_action;
$execactionfunc[CLOSEF] = \&execute_closef_action;
$execactionfunc[OWRITECL] = \&execute_owritecl_action;
$execactionfunc[UDGRAM] = \&execute_udgram_action;
$execactionfunc[CLOSEUDGR] = \&execute_closeudgr_action;
$execactionfunc[USTREAM] = \&execute_ustream_action;
$execactionfunc[CLOSEUSTR] = \&execute_closeustr_action;
$execactionfunc[UDPSOCK] = \&execute_udpsock_action;
$execactionfunc[CLOSEUDP] = \&execute_closeudp_action;
$execactionfunc[TCPSOCK] = \&execute_tcpsock_action;
$execactionfunc[CLOSETCP] = \&execute_closetcp_action;
$execactionfunc[SHELLCOMMAND] = \&execute_shellcmd_action;
$execactionfunc[COMMANDEXEC] = \&execute_cmdexec_action;
$execactionfunc[SPAWN] = \&execute_spawn_action;
$execactionfunc[SPAWNEXEC] = \&execute_spawnexec_action;
$execactionfunc[CSPAWN] = \&execute_cspawn_action;
$execactionfunc[CSPAWNEXEC] = \&execute_cspawnexec_action;
$execactionfunc[PIPE] = \&execute_pipe_action;
$execactionfunc[PIPEEXEC] = \&execute_pipeexec_action;
$execactionfunc[CREATECONTEXT] = \&execute_create_action;
$execactionfunc[DELETECONTEXT] = \&execute_delete_action;
$execactionfunc[OBSOLETECONTEXT] = \&execute_obsolete_action;
$execactionfunc[SETCONTEXT] = \&execute_set_action;
$execactionfunc[ALIAS] = \&execute_alias_action;
$execactionfunc[UNALIAS] = \&execute_unalias_action;
$execactionfunc[ADD] = \&execute_add_action;
$execactionfunc[PREPEND] = \&execute_prepend_action;
$execactionfunc[FILL] = \&execute_fill_action;
$execactionfunc[REPORT] = \&execute_report_action;
$execactionfunc[REPORTEXEC] = \&execute_reportexec_action;
$execactionfunc[COPYCONTEXT] = \&execute_copy_action;
$execactionfunc[EMPTYCONTEXT] = \&execute_empty_action;
$execactionfunc[POP] = \&execute_pop_action;
$execactionfunc[SHIFT] = \&execute_shift_action;
$execactionfunc[EXISTS] = \&execute_exists_action;
$execactionfunc[GETSIZE] = \&execute_getsize_action;
$execactionfunc[GETALIASES] = \&execute_getaliases_action;
$execactionfunc[GETLIFETIME] = \&execute_getltime_action;
$execactionfunc[SETLIFETIME] = \&execute_setltime_action;
$execactionfunc[GETCTIME] = \&execute_getctime_action;
$execactionfunc[SETCTIME] = \&execute_setctime_action;
$execactionfunc[EVENT] = \&execute_event_action;
$execactionfunc[TEVENT] = \&execute_tevent_action;
$execactionfunc[CEVENT] = \&execute_cevent_action;
$execactionfunc[RESET] = \&execute_reset_action;
$execactionfunc[GETWINPOS] = \&execute_getwpos_action;
$execactionfunc[SETWINPOS] = \&execute_setwpos_action;
$execactionfunc[ASSIGN] = \&execute_assign_action;
$execactionfunc[ASSIGNSQ] = \&execute_assignsq_action;
$execactionfunc[FREE] = \&execute_free_action;
$execactionfunc[EVAL] = \&execute_eval_action;
$execactionfunc[CALL] = \&execute_call_action;
$execactionfunc[LCALL] = \&execute_lcall_action;
$execactionfunc[REWRITE] = \&execute_rewrite_action;
$execactionfunc[ADDINPUT] = \&execute_addinput_action;
$execactionfunc[DROPINPUT] = \&execute_dropinput_action;
$execactionfunc[SIGEMUL] = \&execute_sigemul_action;
$execactionfunc[VARIABLESET] = \&execute_varset_action;
$execactionfunc[IF] = \&execute_if_action;
$execactionfunc[WHILE] = \&execute_while_action;
$execactionfunc[BREAK] = \&execute_break_action;
$execactionfunc[CONTINUE] = \&execute_continue_action;
### create a template that is shared by all internal contexts; note that
### the Internal flag blocks actions that modify the internal context
$int_context = { "Time" => time(),
"Window" => 0,
"Buffer" => [],
"Action" => [],
"Desc" => "SEC internal",
"Internal" => 1,
"Aliases" => { } };
### ignore SIGPIPE (done before generating any output)
$SIG{PIPE} = 'IGNORE';
### 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);
}
### If requested, change the user and group ID
if (defined($username)) { set_user_and_group_id(); }
### If requested, change the umask
if (defined($umask)) { set_umask(); }
### Start the logging
if (defined($logfile)) { open_logfile($logfile); } else { $logopen = 0; }
if (defined($syslogf)) { open_syslog($syslogf); } else { $syslogopen = 0; }
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); }
}
### if --bufsize command line option has not been provided or --bufsize=0,
### set --bufsize by analyzing loaded rules
if (!$bufsize) { set_bufsize_option(); }
### 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 (defined($pidfile)) { create_pidfile($pidfile); }
### Set signal handlers
$sigreceived = 0;
$refresh = 0;
$SIG{HUP} = \&hup_handler;
$softrefresh = 0;
$SIG{ABRT} = \&abrt_handler;
$dumpdata = 0;
$SIG{USR1} = \&usr1_handler;
$openlog = 0;
$SIG{USR2} = \&usr2_handler;
$debuglevelinc = 0;
if (override_sigint()) {
$SIG{INT} = \&int_handler;
} else {
log_msg(LOG_NOTICE,
"Interactive process, SIGINT can't be used for changing the logging level");
}
%terminate = ();
$SIG{TERM} = \&term_handler;
### Set various global variables
$startuptime = time();
$processedlines = 0;
### Initialize input buffers
arrange_input_buffers();
### Initialize correlation list, context list,
### buffer list, and child process list
%corr_list = ();
%context_list = ();
%children = ();
### Initialize event buffers
@events = ();
@pending_events = ();
### Initialize builtin action list variables
$timevar_update = time();
set_actionlist_time_var($timevar_update);
set_actionlist_char_var();
### If --intevents flag was specified, create generate the SEC_STARTUP event
if ($intevents) { internal_event("SEC_STARTUP"); }
### search lists for accomplishing timed tasks and removing obsolete elements
### (triggers Calendar rules, must be done between SEC_STARTUP and main loop)
process_lists();
$lastcleanuptime = time();
### read lines from input stream and process them
main_loop();