#!/usr/bin/perl -w # # SEC version 2.3.3 - sec.pl # simple event correlation tool # # Copyright (C) 2000-2006 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # package main::SEC; # Parameters: par1 - perl code to be evaluated # par2 - if set to 0, the code will be evaluated in scalar # context; if 1, list context is used for evaluation # Action: calls eval() for the perl code par1, and returns an array with # the eval() return value(s). The first element of the array # indicates whether the code was evaluated successfully (i.e., # the compilation didn't fail). If code evaluation fails, the # first element of the return array contains the error string. sub call_eval { my($code) = $_[0]; my($listcontext) = $_[1]; my($ok, @result); $ok = 1; if ($listcontext) { @result = eval $code; } else { $result[0] = eval $code; } if ($@) { $ok = 0; chomp($result[0] = $@); } return ($ok, @result); } package main; use strict; # Global Variables use vars qw( $blocksize $bufpos $bufsize @calendar $check_timeout %children $cleantime @conffilepat @conffiles %configuration %context_list %corr_list $debuglevel $detach $dumpdata $dumpfile @events $evstoresize $fromstart @inputfilepat @inputfiles %inputsrc @input_buffer @input_sources $input_timeout $intcontexts $intevents %int_contexts $lastcleanuptime $lastconfigload $logfile @logmsgbuffer $module_options $module $openlog @pending_events $pidfile $poll_timeout $processedlines $quoting @readbuffer $refresh $reopen_timeout $SEC_VERSION $separator $softrefresh $startuptime $syslogavail $syslogf $tail $terminate $testonly $timeout_script %variables $WIN32 ); use Getopt::Long; use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END setsid); use Fcntl; use IO::Handle; $syslogavail = eval { require Sys::Syslog }; $SEC_VERSION = "2.3.3"; # read options given in commandline GetOptions( "conf=s" => \@conffilepat, "input=s" => \@inputfilepat, "input_timeout=i" => \$input_timeout, "timeout_script=s" => \$timeout_script, "reopen_timeout=i" => \$reopen_timeout, "poll_timeout=f" => \$poll_timeout, "check_timeout=i" => \$check_timeout, "blocksize=i" => \$blocksize, "log=s" => \$logfile, "syslog=s" => \$syslogf, "module=s" => \$module_options, "debug=i", \$debuglevel, "pid=s" => \$pidfile, "dump=s" => \$dumpfile, "cleantime=i" => \$cleantime, "bufsize=i" => \$bufsize, "evstoresize=i" => \$evstoresize, "quoting!" => \$quoting, "tail!" => \$tail, "fromstart!" => \$fromstart, "detach!" => \$detach, "intevents!" => \$intevents, "intcontexts!" => \$intcontexts, "testonly!" => \$testonly, "separator=s" => \$separator ); if (!scalar(@conffilepat)) { print STDERR << "USAGE"; Version: $SEC_VERSION Usage: $0 -conf= ... Optional flags: -input=[=] ... -input_timeout= -timeout_script= -reopen_timeout= -poll_timeout= -check_timeout= -blocksize= -log= -syslog= -module= -debug= -pid= -dump= -cleantime= -bufsize= -evstoresize= -quoting, -noquoting -tail, -notail -fromstart, -nofromstart -detach, -nodetach -intevents, -nointevents -intcontexts, -nointcontexts -testonly, -notestonly Obsolete flags: -separator= USAGE exit(1); } ######################################## # Default values for optional flags ######################################## # If timeout_script was not specified as a flag or incorrect value was # specified for input_timeout, set input_timeout to 'undef' regardless # of its value on command line if ( !defined($timeout_script) || (defined($input_timeout) && $input_timeout <= 0) ) { $input_timeout = undef; } # Default value in seconds for time interval that separates two # subsequent passes of lists if (!defined($cleantime) || $cleantime < 0) { $cleantime = 1; } # If incorrect value was specified for reopen timeout, set it to 'undef' if (defined($reopen_timeout) && $reopen_timeout <= 0) { $reopen_timeout = undef; } # Default value for poll timeout if (!defined($poll_timeout) || $poll_timeout < 0) { $poll_timeout = 0.1; } # If incorrect value was specified for check timeout, set it to 'undef' if (defined($check_timeout) && $check_timeout <= 0) { $check_timeout = undef; } # Default value for io block size if (!defined($blocksize) || $blocksize <= 0) { $blocksize = 1024; } # Default value for debuglevel if (!defined($debuglevel) || $debuglevel <= 0) { $debuglevel = 6; } # Default location of dump file if (!defined($dumpfile)) { $dumpfile = "/tmp/sec.dump"; } # Default size of input buffer if (!defined($bufsize) || $bufsize <= 0) { $bufsize = 10; } # Default size of maximum event store size if (!defined($evstoresize) || $evstoresize < 0) { $evstoresize = 0; } # If -quoting and -noquoting are not specified, -noquoting is assumed if (!defined($quoting)) { $quoting = 0; } # If -tail and -notail are not specified, -tail is assumed if (!defined($tail)) { $tail = 1; } # If -fromstart and -nofromstart are not specified, -nofromstart is assumed if (!defined($fromstart)) { $fromstart = 0; } # If -detach and -nodetach are not specified, -nodetach is assumed if (!defined($detach)) { $detach = 0; } # If -intevents and -nointevents are not specified, -nointevents is assumed if (!defined($intevents)) { $intevents = 0; } # If -intcontexts and -nointcontexts are not specified, -nointcontexts is assumed if (!defined($intcontexts)) { $intcontexts = 0; } # If -testonly and -notestonly are not specified, -notestonly is assumed if (!defined($testonly)) { $testonly = 0; } # The -separator flag is obsolete; ignore command line and just set it here $separator = " | "; ################################################################## ##### 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 SUPPRESS => 7; use constant CALENDAR => 8; use constant SUBSTR => 0; use constant REGEXP => 1; use constant PERLFUNC => 2; use constant NSUBSTR => 3; use constant NREGEXP => 4; use constant NPERLFUNC => 5; use constant TVALUE => 6; use constant MODULE_PAT => 7; use constant DONTCONT => 0; use constant TAKENEXT => 1; use constant NONE => 0; use constant LOGONLY => 1; use constant WRITE => 2; use constant SHELLCOMMAND => 3; use constant SPAWN => 4; use constant PIPE => 5; use constant CREATECONTEXT => 6; use constant DELETECONTEXT => 7; use constant OBSOLETECONTEXT => 8; use constant SETCONTEXT => 9; use constant ALIAS => 10; use constant UNALIAS => 11; use constant ADD => 12; use constant FILL => 13; use constant REPORT => 14; use constant COPYCONTEXT => 15; use constant EMPTYCONTEXT => 16; use constant EVENT => 17; use constant RESET => 18; use constant ASSIGN => 19; use constant EVAL => 20; use constant CALL => 21; use constant MODULE_ACT => 22; use constant OPERAND => 0; use constant NEGATION => 1; use constant AND => 2; use constant OR => 3; use constant EXPRESSION => 4; use constant ECODE => 5; use constant CCODE => 6; use constant EXPRSYMBOL => "\0"; use constant LOG_CRIT => 1; use constant LOG_ERR => 2; use constant LOG_WARN => 3; use constant LOG_NOTICE => 4; use constant LOG_INFO => 5; use constant LOG_DEBUG => 6; use constant SYSLOG_LEVELS => { 1 => "crit", 2 => "err", 3 => "warning", 4 => "notice", 5 => "info", 6 => "debug" }; use constant TERMTIMEOUT => 3; use constant CONFIG_KEYWORDS => { type => 1, continue => 1, ptype => 1, pattern => 1, context => 1, desc => 1, action => 1, window => 1, thresh => 1, continue2 => 1, ptype2 => 1, pattern2 => 1, context2 => 1, desc2 => 1, action2 => 1, window2 => 1, thresh2 => 1, time => 1, script => 1 }; ##### Platform checks ##### $WIN32 = ($^O =~ /win/i && $^O !~ /cygwin/i && $^O !~ /darwin/i); ############################################################### # ------------------------- FUNCTIONS ------------------------- ############################################################### ############################## # Functions related to logging ############################## # Parameters: par1 - name of the logfile # Action: logfile will be opened. Filehandle of the logfile will be # saved to the global filehandle LOGFILE. sub open_logfile { my($logfile) = $_[0]; if (open(LOGFILE, ">>$logfile")) { select LOGFILE; $| = 1; select STDOUT; } else { if (-t STDERR || -f STDERR) { print STDERR "Can't open logfile $logfile ($!), exiting!\n"; } child_cleanup(); exit(1); } } # Parameters: par1 - syslog facility # Action: open connection to the system logger with the facility par1. sub open_syslog { my($facility) = $_[0]; my($progname); if (!$syslogavail) { if (-t STDERR || -f STDERR) { print STDERR "Can't connect to syslog (no Sys::Syslog), exiting!\n"; } child_cleanup(); exit(1); } $progname = $0; $progname =~ s/.*\///; eval { Sys::Syslog::openlog($progname, "cons,pid", $facility) }; if ($@) { if (-t STDERR || -f STDERR) { print STDERR "Can't connect to syslog ($@), exiting!\n"; } child_cleanup(); exit(1); } } sub open_module { my $module_options = $_[0]; my ($name, $opt); if ($module_options =~ /^(\w+)\[([^\]]*)\]$/) { ($name, $opt) = ("SEC::$1", $2); } elsif ($module_options =~ /(\w+)/) { ($name, $opt) = ("SEC::$1", ''); } eval "require $name"; if ($@) { my $errmsg = $@; if (-t STDERR || -f STDERR) { print STDERR "Can't use module ($name), exiting!\n"; print STDERR $@; } child_cleanup(); exit(1); } $module = $name->new($opt); if (!$module->open()) { if (-t STDERR || -f STDERR) { print STDERR "Can't open module ($name), exiting!\n"; } child_cleanup(); exit(1); } } # Parameters: par1 - severity of the log message # par2, par3, ... - strings to be logged # Action: strings par2, par3, ... will be equipped with timestamp and # written to LOGFILE and/or forwarded to the system logger as # a single line. If STDERR is connected to terminal, message will # also be written there. If SIGHUP, SIGABRT or SIGUSR2 signal has # arrived but is not processed yet, strings par2, par3, ... will be # placed to a buffer and will be written to a logfile at a later time. sub log_msg { my($level) = shift(@_); my($ltime, $msg); if (!defined($logfile) && !defined($syslogf) && ! -t STDERR) { return; } $msg = join(" ", @_); if (-t STDERR) { print STDERR "$msg\n"; } if (defined($logfile)) { $ltime = localtime(time()); if ($refresh || $softrefresh || $openlog) { push @logmsgbuffer, "$ltime: $msg\n"; } else { print LOGFILE "$ltime: $msg\n"; } } if (defined($syslogf)) { $msg =~ s/%/%%/g; eval { Sys::Syslog::syslog(SYSLOG_LEVELS->{$level}, $msg) }; } } # Parameters: - # Action: write messages from temporary message buffer to logfile sub write_logmsgbuffer { my($histmsg); if (scalar(@logmsgbuffer)) { foreach $histmsg (@logmsgbuffer) { print LOGFILE $histmsg; } @logmsgbuffer = (); } } ####################################################### # Functions related to configuration file(s) processing ####################################################### # Parameters: par1 - value to be checked # Action: return 1 if par1 is 0 or positive integer, 0 otherwise # ($value must consist of 0-9 characters only for 1 to be returned, # no leading or trailing whitespace symbols are permitted) sub is_uinteger { my($value) = $_[0]; return !($value =~ tr/[0-9]//cd); } # Parameters: par1, par2, .. - strings # Action: All 2-byte substrings in par1, par2, .. that denote special # symbols ("\n", "\t", ..) will be replaced with corresponding # special symbols sub subst_specchar { my($pos, $pos2); my($string, $specchar); foreach $string (@_) { $pos2 = 0; for (;;) { $pos = index($string, "\\", $pos2); if ($pos == -1) { last; } if ($pos == length($string) - 1) { chop($string); last; } $specchar = substr($string, $pos + 1, 1); if ($specchar eq "t") { $specchar = "\t"; } elsif ($specchar eq "n") { $specchar = "\n"; } elsif ($specchar eq "r") { $specchar = "\r"; } elsif ($specchar eq "s") { $specchar = " "; } elsif ($specchar eq "0") { $specchar = ""; } substr($string, $pos, 2) = $specchar; $pos2 = $pos + length($specchar); } } } # Parameters: par1 - expression # par2 - reference to an array # Action: parentheses and their contents will be replaced with special # symbols EXPRSYMBOL in par 1. The expressions inside parentheses # will be returned in par2. Previous content of the array par2 # is erased. If par1 was parsed successfully, the modified par1 # will be returned, otherwise undef is returned. sub replace_subexpr { my($expression) = $_[0]; my($expr_ref) = $_[1]; my($i, $j, $l, $pos); my($char, $prev); @{$expr_ref} = (); $i = 0; $j = 0; $l = length($expression); $pos = undef; $prev = ""; while ($i < $l) { # process expression par1 from the start and inspect every symbol, # adding 1 to $j for every '(' and subtracting 1 for every ')'; # if a parenthesis is masked with a backslash, it is ignored $char = substr($expression, $i, 1); if ($prev ne "\\") { if ($char eq "(") { ++$j; } elsif ($char eq ")") { --$j; } } # After observing first '(' save its position to $pos; # after observing its counterpart ')' replace everything # from '(' to ')' with EXPRSYMBOL (including possible nested # expressions), and save the content of parentheses; # if at some point $j becomes negative, the parentheses must # be unbalanced if ($j == 1 && !defined($pos)) { $pos = $i; } elsif ($j == 0 && defined($pos)) { # take symbols starting from position $pos+1 (next symbol after # '(') up to position $i-1 (the symbol before ')'), and save # the symbols to array push @{$expr_ref}, substr($expression, $pos + 1, $i - $pos - 1); # replace both the parentheses and the symbols between them # with EXPRSYMBOL substr($expression, $pos, $i - $pos + 1) = EXPRSYMBOL; # set the variables according to changes in expression $i = $pos; $l = length($expression); $pos = undef; $char = ""; } elsif ($j < 0) { return undef; } # extra ')' was found $prev = $char; ++$i; } # if the parsing ended with non-zero $j, the parentheses were unbalanced if ($j == 0) { return $expression; } else { return undef; } } # Parameters: par1 - continue value (string) # par2 - the name of the configuration file # par3 - line number in configuration file # Action: par1 will be analyzed and the integer continue value will be # returned. If errors are found when analyzing par1, error message # about improper line par3 in configuration file will be logged. sub analyze_continue { my($continue) = $_[0]; my($conffile) = $_[1]; my($lineno) = $_[2]; if (uc($continue) eq "TAKENEXT") { return TAKENEXT; } elsif (uc($continue) eq "DONTCONT") { return DONTCONT; } if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid continue value '$continue'"); } return INVALIDVALUE; } # Parameters: par1 - pattern type (string) # par2 - pattern # par3 - the name of the configuration file # par4 - line number in configuration file # par5 - if we are dealing with the second pattern of Pair* # rule, par5 contains the type of the first pattern # Action: par1 and par2 will be analyzed and tuple of integers # (pattern type, line count, compiled pattern) will be returned # (line count shows how many lines the pattern is designed to match). # If errors are found when analyzing par1 and par2, error message # about improper line par4 in configuration file will be logged. sub analyze_pattern { my($pattype) = $_[0]; my($pat) = $_[1]; my($conffile) = $_[2]; my($lineno) = $_[3]; my($negate, $lines); my($evalok, $retval); if ($pattype =~ /^(n?)regexp(\d*)$/i) { if (length($1)) { $negate = 1; } else { $negate = 0; } if (length($2)) { $lines = $2; } else { $lines = 1; } if ($lines > $bufsize || $lines < 1) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid linecount $lines in '$pattype'"); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } eval { "" =~ /$pat/; }; if ($@) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid regular expression '$pat'"); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } if (!defined($_[4]) || $_[4] == TVALUE || $_[4] == SUBSTR || $_[4] == NSUBSTR) { $pat = qr/$pat/; } if ($negate) { return (NREGEXP, $lines, $pat); } else { return (REGEXP, $lines, $pat); } } elsif ($pattype =~ /^(n?)substr(\d*)$/i) { if (length($1)) { $negate = 1; } else { $negate = 0; } if (length($2)) { $lines = $2; } else { $lines = 1; } if ($lines > $bufsize || $lines < 1) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid linecount $lines in '$pattype'"); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } subst_specchar($pat); if ($negate) { return (NSUBSTR, $lines, $pat); } else { return (SUBSTR, $lines, $pat); } } elsif ($pattype =~ /^(n?)perlfunc(\d*)$/i) { if (length($1)) { $negate = 1; } else { $negate = 0; } if (length($2)) { $lines = $2; } else { $lines = 1; } if ($lines > $bufsize || $lines < 1) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid linecount $lines in '$pattype'"); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } ($evalok, $retval) = SEC::call_eval($pat, 0); if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid function '$pat'", defined($retval)?"($retval)":""); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } if ($negate) { return (NPERLFUNC, $lines, $retval); } else { return (PERLFUNC, $lines, $retval); } } elsif ($pattype =~ /^tvalue$/i) { if (uc($pat) ne "TRUE" && uc($pat) ne "FALSE") { if ($debuglevel >= LOG_ERR) { 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"); } else { if (defined($module)) { if ($module->handles_ptype($pattype)) { if (!$module->analyze_pattern($pat)) { return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } return (MODULE_PAT, 1, $pat); } } if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid pattern type '$pattype'"); } return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); } } # Parameters: par1 - action # par2 - the name of the configuration file # par3 - line number in configuration file # par4 - rule ID # Action: par1 will be analyzed and pair of integers # (action type, action description) will be returned. If errors # are found when analyzing par1, error message about improper # line par3 in configuration file will be logged. sub analyze_action { my($action) = $_[0]; my($conffile) = $_[1]; my($lineno) = $_[2]; my($ruleid) = $_[3]; my($file, $cmdline, $progname); my($sign, $rule); my($actionlist, @action); my($createafter, $event); my($lifetime, $context, $alias); my($variable, $value, $code, $codeptr, $params); if ($action =~ /^none$/i) { return NONE; } elsif ($action =~ /^logonly$/i) { return LOGONLY; } elsif ($action =~ /^write\s+(\S+)\s*(.*)/i) { $file = $1; $event = $2; # strip outer parentheses if they exist if ($file =~ /^\s*\(\s*(.*)\)\s*$/) { $file = $1; } if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } # remove backslashes in front of the parentheses $file =~ s/\\([\(\)])/$1/g; $event =~ s/\\([\(\)])/$1/g; if (!length($event)) { $event = "%s"; } return (WRITE, $file, $event); } elsif ($action =~ /^shellcmd\s+(.*\S)/i) { $cmdline = $1; # strip outer parentheses if they exist if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; } # remove backslashes in front of the parentheses $cmdline =~ s/\\([\(\)])/$1/g; $progname = (split(' ', $cmdline))[0]; if (! -f $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - could not find '$progname'"); } } elsif (! -x $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - '$progname' is not executable"); } } return (SHELLCOMMAND, $cmdline); } elsif ($action =~ /^spawn\s+(.*\S)/i) { if ($WIN32) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "'spawn' action is not supported on Win32"); } return INVALIDVALUE; } $cmdline = $1; # strip outer parentheses if they exist if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; } # remove backslashes in front of the parentheses $cmdline =~ s/\\([\(\)])/$1/g; $progname = (split(' ', $cmdline))[0]; if (! -f $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - could not find '$progname'"); } } elsif (! -x $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - '$progname' is not executable"); } } return (SPAWN, $cmdline); } elsif ($action =~ /^pipe\s+'([^']*)'\s*(.*)/i) { $event = $1; $cmdline = $2; # strip outer parentheses if they exist if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; } # remove backslashes in front of the parentheses $event =~ s/\\([\(\)])/$1/g; $cmdline =~ s/\\([\(\)])/$1/g; if (!length($event)) { $event = "%s"; } if (length($cmdline)) { $progname = (split(' ', $cmdline))[0]; if (! -f $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - could not find '$progname'"); } } elsif (! -x $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - '$progname' is not executable"); } } } return (PIPE, $event, $cmdline); } elsif ($action =~ /^create\b\s*(\S*)\s*(\S*)\s*(.*)/i) { $context = $1; $lifetime = $2; $actionlist = $3; if (length($lifetime) && !is_uinteger($lifetime)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Context '$context' has invalid lifetime '$lifetime'"); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($actionlist =~ /^\s*\(\s*(.*)\)\s*$/) { $actionlist = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; if (!length($context)) { $context = "%s"; } if (!length($lifetime)) { $lifetime = 0; } if (!$lifetime && length($actionlist)) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Context '$context' has infinite lifetime,", "ignoring actionlist '$actionlist'"); } $actionlist = ""; } if (length($actionlist)) { if (!analyze_actionlist($actionlist, \@action, $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } return (CREATECONTEXT, $context, $lifetime, [ @action ]); } return (CREATECONTEXT, $context, $lifetime, []); } elsif ($action =~ /^delete\b\s*(\S*)\s*$/i) { $context = $1; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; if (!length($context)) { $context = "%s"; } return (DELETECONTEXT, $context); } elsif ($action =~ /^obsolete\b\s*(\S*)\s*$/i) { $context = $1; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; if (!length($context)) { $context = "%s"; } return (OBSOLETECONTEXT, $context); } elsif ($action =~ /^set\s+(\S+)\s+(\S+)\s*(.*)/i) { $context = $1; $lifetime = $2; $actionlist = $3; if (!is_uinteger($lifetime)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Context '$context' has invalid lifetime '$lifetime'"); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($actionlist =~ /^\s*\(\s*(.*)\)\s*$/) { $actionlist = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; if (!$lifetime && length($actionlist)) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Context '$context' has infinite lifetime,", "ignoring actionlist '$actionlist'"); } $actionlist = ""; } if (length($actionlist)) { if (!analyze_actionlist($actionlist, \@action, $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } return (SETCONTEXT, $context, $lifetime, [ @action ]); } return (SETCONTEXT, $context, $lifetime, []); } elsif ($action =~ /^alias\s+(\S+)\s*(\S*)\s*$/i) { $context = $1; $alias = $2; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($alias =~ /^\s*\(\s*(.*)\)\s*$/) { $alias = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; $alias =~ s/\\([\(\)])/$1/g; if (!length($alias)) { $alias = "%s"; } return (ALIAS, $context, $alias); } elsif ($action =~ /^unalias\b\s*(\S*)\s*$/i) { $alias = $1; # strip outer parentheses if they exist if ($alias =~ /^\s*\(\s*(.*)\)\s*$/) { $alias = $1; } # remove backslashes in front of the parentheses $alias =~ s/\\([\(\)])/$1/g; if (!length($alias)) { $alias = "%s"; } return (UNALIAS, $alias); } elsif ($action =~ /^add\s+(\S+)\s*(.*)/i) { $context = $1; $event = $2; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; $event =~ s/\\([\(\)])/$1/g; if (!length($event)) { $event = "%s"; } return (ADD, $context, $event); } elsif ($action =~ /^fill\s+(\S+)\s*(.*)/i) { $context = $1; $event = $2; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; $event =~ s/\\([\(\)])/$1/g; if (!length($event)) { $event = "%s"; } return (FILL, $context, $event); } elsif ($action =~ /^report\s+(\S+)\s*(.*)/i) { $context = $1; $cmdline = $2; # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } if ($cmdline =~ /^\s*\(\s*(.*)\)\s*$/) { $cmdline = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; $cmdline =~ s/\\([\(\)])/$1/g; if (length($cmdline)) { $progname = (split(' ', $cmdline))[0]; if (! -f $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - could not find '$progname'"); } } elsif (! -x $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - '$progname' is not executable"); } } } return (REPORT, $context, $cmdline); } elsif ($action =~ /^copy\s+(\S+)\s+(\S+)\s*$/i) { $context = $1; $variable = $2; if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $variable does not have the form", "%[||]..."); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; return (COPYCONTEXT, $context, substr($variable, 1)); } elsif ($action =~ /^empty\s+(\S+)\s*(\S*)\s*$/i) { $context = $1; $variable = $2; if (length($variable)) { if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $variable does not have the form", "%[||]..."); } return INVALIDVALUE; } } # strip outer parentheses if they exist if ($context =~ /^\s*\(\s*(.*)\)\s*$/) { $context = $1; } # remove backslashes in front of the parentheses $context =~ s/\\([\(\)])/$1/g; if (!length($variable)) { return (EMPTYCONTEXT, $context, ""); } return (EMPTYCONTEXT, $context, substr($variable, 1)); } elsif ($action =~ /^event\b\s*(\d*)\b\s*(.*)/i) { $createafter = $1; $event = $2; # strip outer parentheses if they exist if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } # remove backslashes in front of the parentheses $event =~ s/\\([\(\)])/$1/g; if (!length($createafter)) { $createafter = 0; } if (!length($event)) { $event = "%s"; } return (EVENT, $createafter, $event); } elsif ($action =~ /^reset\b\s*([\+-]?)(\d*)\b\s*(.*)/i) { $sign = $1; $rule = $2; $event = $3; if (length($rule)) { if ($sign eq "+") { $rule = $ruleid + $rule; } elsif ($sign eq "-") { $rule = $ruleid - $rule; } elsif (!$rule) { $rule = $ruleid; } else { --$rule; } } else { $rule = ""; } # strip outer parentheses if they exist if ($event =~ /^\s*\(\s*(.*)\)\s*$/) { $event = $1; } # remove backslashes in front of the parentheses $event =~ s/\\([\(\)])/$1/g; if (!length($event)) { $event = "%s"; } return (RESET, $conffile, $rule, $event); } elsif ($action =~ /^assign\s+(\S+)\s*(.*)/i) { $variable = $1; $value = $2; if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $variable does not have the form", "%[||]..."); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($value =~ /^\s*\(\s*(.*)\)\s*$/) { $value = $1; } # remove backslashes in front of the parentheses $value =~ s/\\([\(\)])/$1/g; if (!length($value)) { $value = "%s"; } return (ASSIGN, substr($variable, 1), $value); } elsif ($action =~ /^eval\s+(\S+)\s+(.*\S)/i) { $variable = $1; $code = $2; if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $variable does not have the form", "%[||]..."); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($code =~ /^\s*\(\s*(.*)\)\s*$/) { $code = $1; } # remove backslashes in front of the parentheses $code =~ s/\\([\(\)])/$1/g; return (EVAL, substr($variable, 1), $code); } elsif ($action =~ /^call\s+(\S+)\s+(\S+)\s*(.*)/i) { $variable = $1; $codeptr = $2; $params = $3; if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $variable does not have the form", "%[||]..."); } return INVALIDVALUE; } if ($codeptr !~ /^%[A-Za-z][A-Za-z0-9_]*$/) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Variable $codeptr does not have the form", "%[||]..."); } return INVALIDVALUE; } # strip outer parentheses if they exist if ($params =~ /^\s*\(\s*(.*)\)\s*$/) { $params = $1; } # remove backslashes in front of the parentheses $params =~ s/\\([\(\)])/$1/g; return (CALL, substr($variable, 1), substr($codeptr, 1), [ split(' ', $params) ]); } if (defined($module) && $action =~ /^([^\s]+)\s*(.*)$/) { my ($atype, $args) = ($1, $2); if ($module->handles_atype($atype)) { return (MODULE_ACT, $args); } } if ($debuglevel >= LOG_ERR) { 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, every part is analyzed and # pair of integers (action type, action description) will be # saved to @{$par2} for that part. Previous content of the array # is erased. If errors are found when analyzing par1, error # message about improper line par4 in configuration file will # be logged. sub analyze_actionlist { my($actionlist) = $_[0]; my($arrayref) = $_[1]; my($conffile) = $_[2]; my($lineno) = $_[3]; my($ruleid) = $_[4]; my(@parts, $part); my($actiontype, @action); my($newactionlist, @list, $expr); my($pos, $l); @{$arrayref} = (); # replace the actions that are in parentheses with special symbols # and save the actions to @list $newactionlist = replace_subexpr($actionlist, \@list); if (!defined($newactionlist)) { return 0; } @parts = split(/\s*;\s*/, $newactionlist); $l = length(EXPRSYMBOL); foreach $part (@parts) { # substitute special symbols with expressions # that were removed previously for (;;) { $pos = index($part, EXPRSYMBOL); if ($pos == -1) { last; } $expr = shift @list; substr($part, $pos, $l) = "(" . $expr . ")"; } ($actiontype, @action) = analyze_action($part, $conffile, $lineno, $ruleid); if ($actiontype == INVALIDVALUE) { return 0; } push @{$arrayref}, $actiontype, @action; } return 1; } # Parameters: par1 - context expression # par2 - reference to an array # Action: par1 will be analyzed and saved to array par2 in reverse # polish notation form (it is assumed that par1 does not contain # expressions in parentheses). Previous content of the array par2 # is erased. If errors are found when analyzing par1, 0 will be # returned as a value, otherwise 1 will be returned. sub analyze_context_expr { my($context) = $_[0]; my($result) = $_[1]; my($pos, $op1, $op2); my(@side1, @side2); my($evalok, $retval); # if we are parsing '&&' and '||' operators that take 2 operands, # process the context expression from the end with rindex(), in order # to get "from left to right" processing for AND and OR at runtime $pos = rindex($context, "||"); if ($pos != -1) { $op1 = substr($context, 0, $pos); $op2 = substr($context, $pos + 2); if (!analyze_context_expr($op1, \@side1)) { return 0; } if (!analyze_context_expr($op2, \@side2)) { return 0; } @{$result} = ( @side1, @side2, OR ); return 1; } $pos = rindex($context, "&&"); if ($pos != -1) { $op1 = substr($context, 0, $pos); $op2 = substr($context, $pos + 2); if (!analyze_context_expr($op1, \@side1)) { return 0; } if (!analyze_context_expr($op2, \@side2)) { return 0; } @{$result} = ( @side1, @side2, AND ); return 1; } # check for possible typos for '!' operator (any preceding illegal symbols) $pos = index($context, "!"); if ($pos != -1) { $op1 = substr($context, 0, $pos); $op2 = substr($context, $pos + 1); if ($op1 !~ /^\s*$/) { return 0; } if (!analyze_context_expr($op2, \@side2)) { return 0; } @{$result} = ( @side2, NEGATION ); return 1; } # since CCODE, ECODE and OPERAND are terminals, make sure that any # leading and trailing whitespace is removed from their parameters # (rest of the code relies on that); also, remove backslashes in front # of the parentheses if ($context =~ /^\s*(.*?)\s*->\s*(.*\S)/) { $op1 = $1; $op2 = $2; if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([\(\)])/$1/g; $op1 = [ split(' ', $op1) ]; } if ($op2 ne EXPRSYMBOL) { $op2 =~ s/\\([\(\)])/$1/g; ($evalok, $retval) = SEC::call_eval($op2, 0); if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Eval '$op2' didn't return a code reference:", defined($retval)?$retval:"undef"); } return 0; } $op2 = $retval; } @{$result} = ( CCODE, $op1, $op2 ); return 1; } if ($context =~ /^\s*=\s*(.*\S)/) { $op1 = $1; if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([\(\)])/$1/g; } @{$result} = ( ECODE, $op1 ); return 1; } if ($context =~ /^\s*(.*\S)/) { $op1 = $1; if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([\(\)])/$1/g; } @{$result} = ( OPERAND, $op1 ); return 1; } return 0; } # Parameters: par1 - context description # par2 - reference to an array # Action: par1 will be analyzed and saved to array par2 in reverse # polish notation form. Previous content of the array par2 is erased. # If errors are found when analyzing par1, 0 will be returned as # a value, otherwise 1 will be returned. sub analyze_context { my($context) = $_[0]; my($result) = $_[1]; my($newcontext, $i, $j); my($params, $code, $evalok, $retval); my($subexpr, @expr); # replace upper level expressions in parentheses with special symbol # and save the expressions to @expr (i.e. !(a && (b || c )) || d # becomes !specialsymbol || d, and "a && (b || c )" is saved to @expr); # if context was not parsed successfully, exit $newcontext = replace_subexpr($context, \@expr); if (!defined($newcontext)) { return 0; } # convert the context to reverse polish notation, and if there # were no parenthesized subexpressions found in the context during # previous step, exit if (!analyze_context_expr($newcontext, $result)) { return 0; } if ($newcontext eq $context) { return 1; } # If the context contains parenthesized subexpressions, analyze and # convert these expressions recursively, attaching the results to # the current context. If a parenthesized expression is a Perl mini- # program, it will not be analyzed recursively but rather treated # as a terminal (backslashes in front of the parentheses are removed) $i = 0; $j = scalar(@{$result}); while ($i < $j) { if ($result->[$i] == OPERAND) { if ($result->[$i+1] eq EXPRSYMBOL) { $result->[$i] = EXPRESSION; $result->[$i+1] = []; $subexpr = shift @expr; if (!analyze_context($subexpr, $result->[$i+1])) { return 0; } } $i += 2; } elsif ($result->[$i] == ECODE) { if ($result->[$i+1] eq EXPRSYMBOL) { $code = shift @expr; $code =~ s/\\([\(\)])/$1/g; $result->[$i+1] = $code; } $i += 2; } elsif ($result->[$i] == CCODE) { if ($result->[$i+1] eq EXPRSYMBOL) { $params = shift @expr; $params =~ s/\\([\(\)])/$1/g; $result->[$i+1] = [ split(' ', $params) ]; } if ($result->[$i+2] eq EXPRSYMBOL) { $code = shift @expr; $code =~ s/\\([\(\)])/$1/g; ($evalok, $retval) = SEC::call_eval($code, 0); if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Eval '$code' didn't return a code reference:", defined($retval)?$retval:"undef"); } return 0; } $result->[$i+2] = $retval; } $i += 3; } else { ++$i; } } return 1; } # Parameters: par1 - context description # Action: if par1 is surrounded by [] brackets, the brackets will be # removed and 1 will be returned, otherwise 0 will be returned. sub check_context_preeval { if ($_[0] =~ /^\s*\[(.*)\]\s*$/) { $_[0] = $1; return 1; } else { return 0; } } # Parameters: par1 - list of the time values # par2 - minimum possible value for time # par3 - maximum possible value for time # par4 - offset that must be added to every list value # par5 - reference to a hash where every list value is added # Action: take the list definition and find the time values that belong # to the list (list definition is given in crontab-style). # After the values have been calculated, add an element to the # par5 with the key that equals to the calculated value + offset # (if offset is 0, then "2,5-7" becomes 2,5,6,7; if offset is -1, # min is 1, and max is 12, then "2,5-7,11-" becomes 1,4,5,6,10,11). # Before adding elements to par5, its previous content is erased. # If par1 is a list specified incorrectly, return value is 0, # otherwise 1 is returned sub eval_timelist { my($spec) = $_[0]; my($min) = $_[1]; my($max) = $_[2]; my($offset) = $_[3]; my($ref) = $_[4]; my(@parts, $part); my($pos, $range1, $range2); my($i, $j); # split time specification into parts (by comma) and look what # ranges or individual numbers every part defines @parts = split(/,/, $spec); if (!scalar(@parts)) { return 0; } %{$ref} = (); foreach $part (@parts) { # if part is empty, skip it and take the next part if (!length($part)) { next; } # if part equals to '*', assume that it defines the range min..max if ($part eq "*") { # add offset (this also forces numeric context, so "05" becomes "5") # and save values to the hash $i = $min + $offset; $j = $max + $offset; while ($i <= $j) { $ref->{$i++} = 1; } next; } # if part is not empty and not '*', check if it contains '-' $pos = index($part, "-"); if ($pos == -1) { # if part does not contain '-', assume it defines a single number if (!is_uinteger($part)) { return 0; } if ($part < $min || $part > $max) { return 0; } # add offset (this also forces numeric context, so "05" becomes "5") # and save value to the hash $part += $offset; $ref->{$part} = 1; } else { # if part does contain '-', assume it defines a range $range1 = substr($part, 0, $pos); $range2 = substr($part, $pos + 1); # if left side of the range is missing, assume minimum for the value; # if right side of the range is missing, assume maximum for the value; # offset is then added to the left and right side of the range # (this also forces numeric context, so "05" becomes "5") if (length($range1)) { if (!is_uinteger($range1)) { return 0; } if ($range1 < $min || $range1 > $max) { return 0; } $i = $range1 + $offset; } else { $i = $min + $offset; } if (length($range2)) { if (!is_uinteger($range2)) { return 0; } if ($range2 < $min || $range2 > $max) { return 0; } $j = $range2 + $offset; } else { $j = $max + $offset; } # save values to the hash while ($i <= $j) { $ref->{$i++} = 1; } } } return 1; } # Parameters: par1 - time specification # par2..par6 - references to the hashes of minutes, hours, # days, months and weekdays # par7 - the name of the configuration file # par8 - line number in configuration file # Action: par1 will be split to parts, every part is analyzed and # results are saved into hashes par2..par6. # Previous content of the hashes is erased. If errors # are found when analyzing par1, 0 is returned, otherwise 1 # will be return value. sub analyze_timespec { my($timespec) = $_[0]; my($minref) = $_[1]; my($hourref) = $_[2]; my($dayref) = $_[3]; my($monthref) = $_[4]; my($wdayref) = $_[5]; my($conffile) = $_[6]; my($lineno) = $_[7]; my(@parts); @parts = split(' ', $timespec); if (scalar(@parts) != 5) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Wrong number of elements in time specification"); } return 0; } # evaluate minute specification (range 0..59, offset 0) if (!eval_timelist($parts[0], 0, 59, 0, $minref)) { if ($debuglevel >= LOG_ERR) { 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)) { if ($debuglevel >= LOG_ERR) { 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)) { if ($debuglevel >= LOG_ERR) { 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)) { if ($debuglevel >= LOG_ERR) { 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)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid weekday specification '$parts[4]'"); } return 0; } # if 7 was specified as a weekday, also define 0, # since perl uses only 0 for Sunday if (exists($wdayref->{"7"})) { $wdayref->{"0"} = 1; } return 1; } # Parameters: par1 - reference to a hash containing the rule # par2 - list of required keywords for the rule # par3 - the type of the rule # par4 - the name of the configuration file # par5 - line number in configuration file the rule begins at # Action: check if all required keywords are present in the rule par1 sub missing_keywords { my($ref) = $_[0]; my($keylist) = $_[1]; my($type) = $_[2]; my($conffile) = $_[3]; my($lineno) = $_[4]; my($key, $error); $error = 0; foreach $key (@{$keylist}) { if (!exists($ref->{$key})) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Keyword '$key' missing (needed for the rule type $type)"); } $error = 1; } } return $error; } # Parameters: par1 - reference to a hash containing the rule # par2 - name of the configuration file # par3 - line number in configuration file the rule begins at # par4 - rule ID # Action: check the rule par1 for correctness and save it to # global array $configuration{par2} if it is well-defined; # if the rule was correctly defined, return 1, otherwise return 0 sub check_rule { my($ref) = $_[0]; my($conffile) = $_[1]; my($lineno) = $_[2]; my($number) = $_[3]; my($config, @keywords); my($type, $progname); my($whatnext, $pattype, $patlines, $pattern, $contpreeval); my($whatnext2, $pattype2, $patlines2, $pattern2, $contpreeval2); my(@context, @action, @context2, @action2); my(%minutes, %hours, %days, %months, %weekdays); $config = $configuration{$conffile}; if (!exists($ref->{"type"})) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Keyword 'type' missing"); } return 0; } $type = uc($ref->{"type"}); # ------------------------------------------------------------ # SINGLE rule # ------------------------------------------------------------ if ($type eq "SINGLE") { @keywords = ("ptype", "pattern", "desc", "action"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } $config->[$number] = { "ID" => $number, "Type" => SINGLE, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # SINGLE_W_SCRIPT rule # ------------------------------------------------------------ elsif ($type eq "SINGLEWITHSCRIPT") { @keywords = ("ptype", "pattern", "script", "desc", "action"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } $progname = (split(' ', $ref->{"script"}))[0]; if (! -f $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - could not find '$progname'"); } } elsif (! -x $progname) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", "Warning - '$progname' is not executable"); } } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (exists($ref->{"action2"})) { if (!analyze_actionlist($ref->{"action2"}, \@action2, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action2"}, "'"); } return 0; } } else { @action2 = (); } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } $config->[$number] = { "ID" => $number, "Type" => SINGLE_W_SCRIPT, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Script" => $ref->{"script"}, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "Action2" => [ @action2 ], "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # SINGLE_W_SUPPRESS rule # ------------------------------------------------------------ elsif ($type eq "SINGLEWITHSUPPRESS") { @keywords = ("ptype", "pattern", "desc", "action", "window"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid time window '", $ref->{"window"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } $config->[$number] = { "ID" => $number, "Type" => SINGLE_W_SUPPRESS, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "Window" => $ref->{"window"}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # PAIR rule # ------------------------------------------------------------ elsif ($type eq "PAIR") { @keywords = ("ptype", "pattern", "desc", "action", "ptype2", "pattern2", "desc2", "action2"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (!exists($ref->{"continue2"})) { $whatnext2 = DONTCONT; } else { $whatnext2 = analyze_continue($ref->{"continue2"}, $conffile, $lineno); } if ($whatnext2 == INVALIDVALUE) { return 0; } ($pattype2, $patlines2, $pattern2) = analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"}, $conffile, $lineno, $pattype); if ($pattype2 == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action2"}, \@action2, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action2"}, "'"); } return 0; } if (!exists($ref->{"window"})) { $ref->{"window"} = 0; } elsif (!is_uinteger($ref->{"window"})) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid time window '", $ref->{"window"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 1st context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } if (exists($ref->{"context2"})) { $contpreeval2 = check_context_preeval($ref->{"context2"}); if (!analyze_context($ref->{"context2"}, \@context2)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 2nd context specification '", $ref->{"context2"}, "'"); } return 0; } } else { @context2 = (); $contpreeval2 = 0; } $config->[$number] = { "ID" => $number, "Type" => PAIR, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "WhatNext2" => $whatnext2, "PatType2" => $pattype2, "Pattern2" => $pattern2, "PatLines2" => $patlines2, "Context2" => [ @context2 ], "ContPreEval2" => $contpreeval2, "Desc2" => $ref->{"desc2"}, "Action2" => [ @action2 ], "Window" => $ref->{"window"}, "Operations" => {}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # PAIR_W_WINDOW rule # ------------------------------------------------------------ elsif ($type eq "PAIRWITHWINDOW") { @keywords = ("ptype", "pattern", "desc", "action", "ptype2", "pattern2", "desc2", "action2", "window"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (!exists($ref->{"continue2"})) { $whatnext2 = DONTCONT; } else { $whatnext2 = analyze_continue($ref->{"continue2"}, $conffile, $lineno); } if ($whatnext2 == INVALIDVALUE) { return 0; } ($pattype2, $patlines2, $pattern2) = analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"}, $conffile, $lineno, $pattype); if ($pattype2 == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action2"}, \@action2, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action2"}, "'"); } return 0; } if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid time window '", $ref->{"window"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 1st context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } if (exists($ref->{"context2"})) { $contpreeval2 = check_context_preeval($ref->{"context2"}); if (!analyze_context($ref->{"context2"}, \@context2)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 2nd context specification '", $ref->{"context2"}, "'"); } return 0; } } else { @context2 = (); $contpreeval2 = 0; } $config->[$number] = { "ID" => $number, "Type" => PAIR_W_WINDOW, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "WhatNext2" => $whatnext2, "PatType2" => $pattype2, "Pattern2" => $pattern2, "PatLines2" => $patlines2, "Context2" => [ @context2 ], "ContPreEval2" => $contpreeval2, "Desc2" => $ref->{"desc2"}, "Action2" => [ @action2 ], "Window" => $ref->{"window"}, "Operations" => {}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # SINGLE_W_THRESHOLD rule # ------------------------------------------------------------ elsif ($type eq "SINGLEWITHTHRESHOLD") { @keywords = ("ptype", "pattern", "desc", "action", "window", "thresh"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid time window '", $ref->{"window"}, "'"); } return 0; } if (!is_uinteger($ref->{"thresh"}) || $ref->{"thresh"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid threshold '", $ref->{"thresh"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } $config->[$number] = { "ID" => $number, "Type" => SINGLE_W_THRESHOLD, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "Window" => $ref->{"window"}, "Threshold" => $ref->{"thresh"}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # SINGLE_W_2_THRESHOLDS rule # ------------------------------------------------------------ elsif ($type eq "SINGLEWITH2THRESHOLDS") { @keywords = ("ptype", "pattern", "desc", "action", "window", "thresh", "desc2", "action2", "window2", "thresh2"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!exists($ref->{"continue"})) { $whatnext = DONTCONT; } else { $whatnext = analyze_continue($ref->{"continue"}, $conffile, $lineno); } if ($whatnext == INVALIDVALUE) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (!is_uinteger($ref->{"window"}) || $ref->{"window"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 1st time window '", $ref->{"window"}, "'"); } return 0; } if (!is_uinteger($ref->{"thresh"}) || $ref->{"thresh"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 1st threshold '", $ref->{"thresh"}, "'"); } return 0; } if (!analyze_actionlist($ref->{"action2"}, \@action2, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action2"}, "'"); } return 0; } if (!is_uinteger($ref->{"window2"}) || $ref->{"window2"} == 0) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 2nd time window '", $ref->{"window2"}, "'"); } return 0; } if (!is_uinteger($ref->{"thresh2"})) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid 2nd threshold '", $ref->{"thresh2"}, "'"); } return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } $config->[$number] = { "ID" => $number, "Type" => SINGLE_W_2_THRESHOLDS, "WhatNext" => $whatnext, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "Action" => [ @action ], "Window" => $ref->{"window"}, "Threshold" => $ref->{"thresh"}, "Desc2" => $ref->{"desc2"}, "Action2" => [ @action2 ], "Window2" => $ref->{"window2"}, "Threshold2" => $ref->{"thresh2"}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # SUPPRESS rule # ------------------------------------------------------------ elsif ($type eq "SUPPRESS") { @keywords = ("ptype", "pattern"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } ($pattype, $patlines, $pattern) = analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); if ($pattype == INVALIDVALUE) { return 0; } if (exists($ref->{"context"})) { $contpreeval = check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); $contpreeval = 0; } if (!exists($ref->{"desc"})) { if ($pattype == REGEXP || $pattype == SUBSTR || $pattype == PERLFUNC) { $ref->{"desc"} = "Suppress rule with pattern: $pattern"; } elsif ($pattype == NREGEXP || $pattype == NSUBSTR || $pattype == NPERLFUNC) { $ref->{"desc"} = "Suppress rule with negative pattern: $pattern"; } else { $ref->{"desc"} = "Suppress rule with pattern: " . ($pattern?"TRUE":"FALSE"); } } $config->[$number] = { "ID" => $number, "Type" => SUPPRESS, "PatType" => $pattype, "Pattern" => $pattern, "PatLines" => $patlines, "Context" => [ @context ], "ContPreEval" => $contpreeval, "Desc" => $ref->{"desc"}, "MatchCount" => 0, "LineNo" => $lineno }; return 1; } # ------------------------------------------------------------ # CALENDAR rule # ------------------------------------------------------------ elsif ($type eq "CALENDAR") { @keywords = ("time", "desc", "action"); if (missing_keywords($ref, \@keywords, $type, $conffile, $lineno)) { return 0; } if (!analyze_timespec($ref->{"time"}, \%minutes, \%hours, \%days, \%months, \%weekdays, $conffile, $lineno)) { return 0; } if (!analyze_actionlist($ref->{"action"}, \@action, $conffile, $lineno, $number)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid action list '", $ref->{"action"}, "'"); } return 0; } if (exists($ref->{"context"})) { # since for Calendar rule []-operator has no meaning, # just remove [] brackets if they exist check_context_preeval($ref->{"context"}); if (!analyze_context($ref->{"context"}, \@context)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Invalid context specification '", $ref->{"context"}, "'"); } return 0; } } else { @context = (); } $config->[$number] = { "ID" => $number, "Type" => CALENDAR, "Minutes" => { %minutes }, "Hours" => { %hours }, "Days" => { %days }, "Months" => { %months }, "Weekdays" => { %weekdays }, "LastMinute" => 0, "LastHour" => 0, "LastDay" => 0, "LastMonth" => 0, "LastWeekday" => 0, "Context" => [ @context ], "Desc" => $ref->{"desc"}, "Action" => [ @action ], "MatchCount" => 0, "LineNo" => $lineno }; push @calendar, $config->[$number]; return 1; } # ------------------------------------------------------------ # unknown rule # ------------------------------------------------------------ else { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", "Unknown ruletype $type"); } return 0; } } # Parameters: par1 - name of the configuration file # Action: read in rules from configuration file par1 and call # check_rule() for every rule; if all rules in the file # were correctly defined, return 1, otherwise return 0 sub read_configfile { my($conffile) = $_[0]; my($linebuf, $line, $i, $cont, $rulestart); my($keyword, $value, $file_status); my(%rule); # start with the assumption that all rules are correctly defined $file_status = 1; if ($debuglevel >= LOG_NOTICE) { log_msg(LOG_NOTICE, "Reading configuration from $conffile"); } if (!open(CONFFILE, "$conffile")) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Can't open configuration file $conffile ($!)"); } return 0; } $configuration{$conffile} = []; $i = 0; $cont = 0; %rule = (); $rulestart = 1; for (;;) { # read next line from file $linebuf = ; # check if the line belongs to previous line; if it does, form a # single line from them and start the loop again (i.e. we will # concatenate lines until we read a line that does not end with '\') if (defined($linebuf)) { chomp($linebuf); if ($cont) { $line .= $linebuf; } else { $line = $linebuf; } # remove whitespaces from line beginnings and ends; # if line is all-whitespace, set it to empty string if ($line =~ /^\s*(.*\S)/) { $line = $1; } else { $line = ""; } # check if line ends with '\'; if it does, remove '\', set $cont # to 1 and jump at the start of loop to read next line, otherwise # set $cont to 0 if (substr($line, length($line) - 1) eq '\\') { chop($line); $cont = 1; next; } else { $cont = 0; } } # if the line constructed during previous loop is empty, starting # with #-symbol, or if we have reached EOF, consider that as the end # of current rule. Check the rule and set $rulestart to the next line. # If we have reached EOF, quit the loop, otherwise take the next line. if (!defined($linebuf) || !length($line) || index($line, '#') == 0) { if (scalar(%rule)) { if (check_rule(\%rule, $conffile, $rulestart, $i)) { ++$i; } else { $file_status = 0; } %rule = (); } $rulestart = $. + 1; if (defined($linebuf)) { next; } else { last; } } # split line into keyword and value if ($line =~ /^\s*([A-Za-z0-9]+)\s*=\s*(.*\S)/) { $keyword = $1; $value = $2; } else { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "$conffile line $.:", "Line $line does not conform to keyword=value format or keyword is not alphanumeric"); } $file_status = 0; next; } # check if the keyword is valid and save it to hash %rule if it is if (!exists(CONFIG_KEYWORDS->{$keyword})) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "$conffile line $.:", "Unknown keyword $keyword"); } $file_status = 0; next; } $rule{$keyword} = $value; } if (!$i) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "No valid rules found in configuration file $conffile"); } delete $configuration{$conffile}; } else { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "$i rules loaded from $conffile"); } } close(CONFFILE); return $file_status; } # Parameters: - # Action: evaluate the conffile patterns given in commandline, form the # list of configuration files and save it to global array # @conffiles, and read in rules from the configuration files sub read_config { my($pattern, $conffile, $ret); # Initialize global arrays %configuration, @calendar, and @conffiles # (the keys for %configuration are members of global array @conffiles), # and set the $lastconfigload variable to reflect the current time $lastconfigload = time(); %configuration = (); @calendar = (); @conffiles = (); # Form the list of configuration files, save it to global array # @conffiles, and read configuration from the files foreach $pattern (@conffilepat) { push @conffiles, glob($pattern); } $ret = 1; foreach $conffile (@conffiles) { if (!read_configfile($conffile)) { $ret = 0; } } return $ret; } ##################################################### # Functions related to processing of lists at runtime ##################################################### # Parameters: par1 - string # par2 - string # Action: all %-variables in string par1 will be replaced with their values. # this will be done recursively until no more replacements are made. sub substitute_var { my ($par1, $par2, $found_match) = ($_[0], $_[1], 1); while (substitute_var_real($_[0], $_[1])) { } } # Parameters: par1 - string # par2 - string # Action: all %-variables in string par1 will be replaced with their values sub substitute_var_real { my($msg) = $_[1]; my($pos, $pos2); my($length, $variable, $varlen); my($timestamp, $timestamp2); $pos2 = 0; $length = length($_[0]); $timestamp = localtime(time()); $timestamp2 = time(); for (;;) { # search for the %-sign $pos = index($_[0], "%", $pos2); if ($pos == -1 || $pos == $length - 1) { return 0; } # find the variable name that follows % if (substr($_[0], $pos + 1, 1) eq "%") { $variable = "%"; $varlen = 2; } elsif (substr($_[0], $pos + 1) =~ /^\{([A-Za-z][A-Za-z0-9_]*)\}/) { $variable = $1; $varlen = length($variable) + 3; } elsif (substr($_[0], $pos + 1) =~ /^([A-Za-z][A-Za-z0-9_]*)/) { $variable = $1; $varlen = length($variable) + 1; } else { $varlen = 0; } # replace the variable with its value if (!$varlen) { $pos2 = $pos + 1; } elsif ($variable eq "%") { substr($_[0], $pos, 2) = "%"; $pos2 = $pos + 1; --$length; } elsif ($variable eq "s") { substr($_[0], $pos, $varlen) = $msg; $pos2 = $pos + length($msg); $length += $pos2 - $pos - $varlen; } elsif ($variable eq "t") { substr($_[0], $pos, $varlen) = $timestamp; $pos2 = $pos + length($timestamp); $length += $pos2 - $pos - $varlen; } elsif ($variable eq "u") { substr($_[0], $pos, $varlen) = $timestamp2; $pos2 = $pos + length($timestamp2); $length += $pos2 - $pos - $varlen; } elsif (exists($variables{$variable})) { substr($_[0], $pos, $varlen) = $variables{$variable}; $pos2 = $pos + length($variables{$variable}); $length += $pos2 - $pos - $varlen; } else { $pos2 = $pos + $varlen; } # if we have reached the end of the string after replacement, terminate if ($pos2 > $length - 1) { return 1; } } } # Parameters: par1 - shell command # par2 - 'collect output' flag # Action: par1 will be executed as a shell command in a child # process. After process has been created, subroutine creates an # entry in the %children hash, and returns the pid of the child # process. If process creation failed, undef is returned. After the # command has completed, the child process terminates and returns # command's exit code as its own exit value. # If par2 is defined and non-zero, command's standard output is # returned to the main process through a pipe. sub shell_cmd { my($cmd) = $_[0]; my($collect_output, $pid); local *READ_FH; # we need to use 'local *', since each time we enter # this procedure a new filehandle must be created, that # will be returned from this procedure for external use if (defined($_[1]) && $_[1]) { $collect_output = 1; } else { $collect_output = 0; } # set up a pipe before calling fork() if ($collect_output && !pipe(READ_FH, WRITE_FH)) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Could not create pipe for command '$cmd' ($!)"); } return undef; } # try to create a child process and return undef, if fork failed; # if fork was successful and we are in parent process, return the # pid of the child process $pid = fork(); if (!defined($pid)) { if ($collect_output) { close(READ_FH); close(WRITE_FH); } if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)"); } return undef; } elsif ($pid) { $children{$pid} = { "cmd" => $cmd, "fh" => undef, "open" => 0, "buffer" => "", "Desc" => undef, "Action" => undef, "Action2" => undef }; if ($collect_output) { close(WRITE_FH); $children{$pid}->{"fh"} = *READ_FH; $children{$pid}->{"open"} = 1; } if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'"); } return $pid; } # we are in the child process now... if ($collect_output) { # connect the standard output of the child process to the pipe # and make the standard output unbuffered close(READ_FH); if (!open(STDOUT, ">&WRITE_FH")) { exit(1); } select(STDOUT); $| = 1; close(WRITE_FH); } # if we have received SIGTERM, exit if ($terminate) { exit(0); } # execute the command inside the child process; if exec() fails, exit exec("$cmd"); exit(1); } # Parameters: par1 - shell command for reporting # par2 - reference to a hash or an array # Action: par1 will be executed as a shell command in a child process, and # contents of array par2 (or keys of hash par2) are fed to its # standard input. After process has been created, subroutine creates # an entry in the %children hash, and returns the pid of the child # process. If process creation failed, undef is returned. # After the command has completed, the child process # terminates and returns command's exit code as its own exit value. sub pipe_cmd { my($cmd) = $_[0]; my($ref) = $_[1]; my($pid, $elem); # try to create a child process and return undef, if fork failed; # if fork was successful and we are in parent process, return the # pid of the child process $pid = fork(); if (!defined($pid)) { if ($debuglevel >= LOG_ERR) { 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 ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'"); } return $pid; } # we are in the child process now... # if we have received SIGTERM, exit; otherwise fork the command if ($terminate) { exit(0); } else { $pid = open(CMDPIPE, "| $cmd"); } if (defined($pid)) { # if the main SEC process has sent us SIGTERM meanwhile, send SIGTERM # to the command and exit; otherwise set the signal handler for SIGTERM if ($terminate) { kill('TERM', $pid); exit(0); } else { $SIG{TERM} = sub { kill('TERM', $pid); exit(0); }; } # ignore SIGPIPE if the command has died or has closed the pipe $SIG{PIPE} = 'IGNORE'; # write data to pipe select CMDPIPE; $| = 1; if (ref($ref) eq "HASH") { while ($elem = each(%{$ref})) { print CMDPIPE $elem, "\n"; } } else { foreach $elem (@{$ref}) { print CMDPIPE $elem, "\n"; } } # In some perl versions the close() function is buggy, and although # SIGPIPE is ignored, close() still sets $? variable to signal an # error, if the forked command does not read its stdin. To overcome # this problem, IO::Handle->flush() must be called before close(), # since this forces the close() function to set $? correctly CMDPIPE->flush(); # note that close() does not return until the command has completed close(CMDPIPE); exit($? >> 8); } else { exit(1); } } # Parameters: par1 - reference to a source action list # par2 - reference to a destination action list # Action: action list par1 will be copied to par2 sub copy_actionlist { my($src_ref) = $_[0]; my($dest_ref) = $_[1]; my($i, $j); @{$dest_ref} = (); $i = 0; $j = scalar(@{$src_ref}); while ($i < $j) { if ($src_ref->[$i] == NONE) { push @{$dest_ref}, NONE; ++$i; } elsif ($src_ref->[$i] == LOGONLY) { push @{$dest_ref}, LOGONLY; ++$i; } elsif ($src_ref->[$i] == WRITE) { push @{$dest_ref}, WRITE; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == SHELLCOMMAND) { push @{$dest_ref}, SHELLCOMMAND; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == SPAWN) { push @{$dest_ref}, SPAWN; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == PIPE) { push @{$dest_ref}, PIPE; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == CREATECONTEXT) { push @{$dest_ref}, CREATECONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; push @{$dest_ref}, []; copy_actionlist($src_ref->[$i+3], $dest_ref->[$i+3]); $i += 4; } elsif ($src_ref->[$i] == DELETECONTEXT) { push @{$dest_ref}, DELETECONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == OBSOLETECONTEXT) { push @{$dest_ref}, OBSOLETECONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == SETCONTEXT) { push @{$dest_ref}, SETCONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; push @{$dest_ref}, []; copy_actionlist($src_ref->[$i+3], $dest_ref->[$i+3]); $i += 4; } elsif ($src_ref->[$i] == ALIAS) { push @{$dest_ref}, ALIAS; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == UNALIAS) { push @{$dest_ref}, UNALIAS; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == ADD) { push @{$dest_ref}, ADD; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == FILL) { push @{$dest_ref}, FILL; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == REPORT) { push @{$dest_ref}, REPORT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == COPYCONTEXT) { push @{$dest_ref}, COPYCONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == EMPTYCONTEXT) { push @{$dest_ref}, EMPTYCONTEXT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == EVENT) { push @{$dest_ref}, EVENT; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == RESET) { push @{$dest_ref}, RESET; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; push @{$dest_ref}, $src_ref->[$i+3]; $i += 4; } elsif ($src_ref->[$i] == ASSIGN) { push @{$dest_ref}, ASSIGN; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == EVAL) { push @{$dest_ref}, EVAL; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } elsif ($src_ref->[$i] == CALL) { push @{$dest_ref}, CALL; push @{$dest_ref}, $src_ref->[$i+1]; push @{$dest_ref}, $src_ref->[$i+2]; push @{$dest_ref}, [ @{$src_ref->[$i+3]} ]; $i += 4; } elsif ($src_ref->[$i] == MODULE_ACT) { push @{$dest_ref}, MODULE_ACT; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } } } # Parameters: par1 - reference to a source context # par2 - reference to a destination context # Action: context par1 will be copied to par2 sub copy_context { my($src_ref) = $_[0]; my($dest_ref) = $_[1]; my($i, $j); @{$dest_ref} = (); $i = 0; $j = scalar(@{$src_ref}); while ($i < $j) { if ($src_ref->[$i] == OPERAND) { push @{$dest_ref}, OPERAND; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == EXPRESSION) { push @{$dest_ref}, EXPRESSION; push @{$dest_ref}, []; copy_context($src_ref->[$i+1], $dest_ref->[$i+1]); $i += 2; } elsif ($src_ref->[$i] == ECODE) { push @{$dest_ref}, ECODE; push @{$dest_ref}, $src_ref->[$i+1]; $i += 2; } elsif ($src_ref->[$i] == CCODE) { push @{$dest_ref}, CCODE; push @{$dest_ref}, [ @{$src_ref->[$i+1]} ]; push @{$dest_ref}, $src_ref->[$i+2]; $i += 3; } else { push @{$dest_ref}, $src_ref->[$i]; ++$i; } } } # Parameters: par1 - reference to a list of actions # par2 - event description text # Action: execute actions in a given action list sub execute_actionlist { my($actionlist) = $_[0]; my($text) = $_[1]; my($text2, $i, $j, $nbytes); my($file, $cmdline, $context, $lifetime, $list); my($createafter, $conffile, $ruleid); my($event, @event, $alias, @aliases, @params); my($variable, $value, $code, @retval, $evalok); my($key, $ref); $i = 0; $j = scalar(@{$actionlist}); while ($i < $j) { if ($actionlist->[$i] == NONE) { ++$i; } elsif ($actionlist->[$i] == LOGONLY) { log_msg(LOG_NOTICE, $text); ++$i; } elsif ($actionlist->[$i] == WRITE) { $file = $actionlist->[$i+1]; $event = $actionlist->[$i+2]; substitute_var($file, $text); substitute_var($event, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Writing event '$event' to file $file"); } if ($file eq "-") { select(STDOUT); $| = 1; print STDOUT "$event\n"; } elsif (-e $file && ! -f $file && ! -p $file) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Can't write event '$event' to file $file!", "(not a regular file or pipe)"); } } elsif (-p $file) { if (sysopen(WRITEFILE, $file, O_WRONLY | O_NONBLOCK)) { $nbytes = syswrite(WRITEFILE, "$event\n"); close(WRITEFILE); if (!defined($nbytes) || $nbytes != length($event) + 1) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Error when writing event '$event' to pipe $file!"); } } } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Can't open pipe $file for writing event '$event'!"); } } } else { if (open(WRITEFILE, ">>$file")) { print WRITEFILE "$event\n"; close(WRITEFILE); } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Can't open file $file for writing event '$event'!"); } } } $i += 3; } elsif ($actionlist->[$i] == SHELLCOMMAND) { $cmdline = $actionlist->[$i+1]; $text2 = $text; # if -quoting flag was specified, mask apostrophes in $text2 # and put $text2 inside apostrophes if ($quoting) { $text2 =~ s/'/'\\''/g; $text2 = "'" . $text2 . "'"; } substitute_var($cmdline, $text2); if ($debuglevel >= LOG_INFO) { log_msg(LOG_INFO, "Executing shell command '$cmdline'"); } shell_cmd($cmdline); $i += 2; } elsif ($actionlist->[$i] == SPAWN) { $cmdline = $actionlist->[$i+1]; $text2 = $text; # if -quoting flag was specified, mask apostrophes in $text2 # and put $text2 inside apostrophes if ($quoting) { $text2 =~ s/'/'\\''/g; $text2 = "'" . $text2 . "'"; } substitute_var($cmdline, $text2); if ($debuglevel >= LOG_INFO) { log_msg(LOG_INFO, "Spawning shell command '$cmdline'"); } shell_cmd($cmdline, 1); $i += 2; } elsif ($actionlist->[$i] == PIPE) { $event = $actionlist->[$i+1]; $cmdline = $actionlist->[$i+2]; substitute_var($event, $text); substitute_var($cmdline, $text); if ($debuglevel >= LOG_INFO) { log_msg(LOG_INFO, "Feeding event '$event' to shell command '$cmdline'"); } if (length($cmdline)) { pipe_cmd($cmdline, [ $event ]); } else { select(STDOUT); $| = 1; print STDOUT "$event\n"; } $i += 3; } elsif ($actionlist->[$i] == CREATECONTEXT) { $context = $actionlist->[$i+1]; $lifetime = $actionlist->[$i+2]; $list = $actionlist->[$i+3]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Creating context '$context'"); } if (exists($context_list{$context})) { $context_list{$context}->{"Time"} = time(); $context_list{$context}->{"Window"} = $lifetime; $context_list{$context}->{"Buffer"} = []; $context_list{$context}->{"Action"} = $list; $context_list{$context}->{"Desc"} = $text; } else { $context_list{$context} = { "Time" => time(), "Window" => $lifetime, "Buffer" => [], "Action" => $list, "Desc" => $text, "Aliases" => [ $context ] }; } $i += 4; } elsif ($actionlist->[$i] == DELETECONTEXT) { $context = $actionlist->[$i+1]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Deleting context '$context'"); } if (exists($context_list{$context}) && !exists($context_list{$context}->{"DeleteInProgress"})) { @aliases = @{$context_list{$context}->{"Aliases"}}; foreach $alias (@aliases) { delete $context_list{$alias}; if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Context '$alias' deleted"); } } } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist or is going through deletion, can't delete"); } } $i += 2; } elsif ($actionlist->[$i] == OBSOLETECONTEXT) { $context = $actionlist->[$i+1]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Obsoleting context '$context'"); } if (exists($context_list{$context}) && !exists($context_list{$context}->{"DeleteInProgress"})) { $context_list{$context}->{"Window"} = -1; valid_context($context); } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist or is going through deletion, can't obsolete"); } } $i += 2; } elsif ($actionlist->[$i] == SETCONTEXT) { $context = $actionlist->[$i+1]; $lifetime = $actionlist->[$i+2]; $list = $actionlist->[$i+3]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Changing settings for context '$context'"); } if (exists($context_list{$context})) { $context_list{$context}->{"Time"} = time(); $context_list{$context}->{"Window"} = $lifetime; $context_list{$context}->{"Action"} = $list; $context_list{$context}->{"Desc"} = $text; } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist, can't change settings"); } } $i += 4; } elsif ($actionlist->[$i] == ALIAS) { $context = $actionlist->[$i+1]; $alias = $actionlist->[$i+2]; substitute_var($context, $text); substitute_var($alias, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Creating alias '$alias' for context '$context'"); } if (!exists($context_list{$context})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist, can't create alias"); } } elsif (exists($context_list{$alias})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Alias '$alias' already exists"); } } else { push @{$context_list{$context}->{"Aliases"}}, $alias; $context_list{$alias} = $context_list{$context}; } $i += 3; } elsif ($actionlist->[$i] == UNALIAS) { $alias = $actionlist->[$i+1]; substitute_var($alias, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Removing alias '$alias'"); } if (exists($context_list{$alias}) && !exists($context_list{$alias}->{"DeleteInProgress"})) { @aliases = grep {$_ ne $alias} @{$context_list{$alias}->{"Aliases"}}; if (scalar(@aliases)) { $context_list{$alias}->{"Aliases"} = [ @aliases ]; } else { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Alias '$alias' was the last reference to a context"); } } delete $context_list{$alias}; } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Alias '$alias' does not exist or its context is going through deletion, can't remove"); } } $i += 2; } elsif ($actionlist->[$i] == ADD) { $context = $actionlist->[$i+1]; $event = $actionlist->[$i+2]; substitute_var($context, $text); substitute_var($event, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Adding event '$event' to context '$context'"); } if (!exists($context_list{$context})) { $context_list{$context} = { "Time" => time(), "Window" => 0, "Buffer" => [], "Action" => [], "Desc" => "", "Aliases" => [ $context ] }; } @event = split(/\n/, $event); if (!$evstoresize || scalar(@{$context_list{$context}->{"Buffer"}}) + scalar(@event) <= $evstoresize) { push @{$context_list{$context}->{"Buffer"}}, @event; } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Can't add event '$event' to context '$context', store full"); } } $i += 3; } elsif ($actionlist->[$i] == FILL) { $context = $actionlist->[$i+1]; $event = $actionlist->[$i+2]; substitute_var($context, $text); substitute_var($event, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Filling context '$context' with event '$event'"); } if (!exists($context_list{$context})) { $context_list{$context} = { "Time" => time(), "Window" => 0, "Buffer" => [], "Action" => [], "Desc" => "", "Aliases" => [ $context ] }; } @event = split(/\n/, $event); if (!$evstoresize || scalar(@event) <= $evstoresize) { $context_list{$context}->{"Buffer"} = [ @event ]; } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Can't fill context '$context' with event '$event', store full"); } } $i += 3; } elsif ($actionlist->[$i] == REPORT) { $context = $actionlist->[$i+1]; $cmdline = $actionlist->[$i+2]; substitute_var($context, $text); substitute_var($cmdline, $text); if ($debuglevel >= LOG_INFO) { log_msg(LOG_INFO, "Reporting the event store of context '$context' through shell command '$cmdline'"); } if (!exists($context_list{$context})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist, can't report"); } } elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Event store of context '$context' is empty, can't report"); } } else { if (length($cmdline)) { pipe_cmd($cmdline, $context_list{$context}->{"Buffer"}); } else { select(STDOUT); $| = 1; foreach $event (@{$context_list{$context}->{"Buffer"}}) { print STDOUT "$event\n"; } } } $i += 3; } elsif ($actionlist->[$i] == COPYCONTEXT) { $context = $actionlist->[$i+1]; $variable = $actionlist->[$i+2]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Copying context '$context' to variable '%$variable'"); } if (!exists($context_list{$context})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist, can't copy"); } } else { $value = join("\n", @{$context_list{$context}->{"Buffer"}}); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } $i += 3; } elsif ($actionlist->[$i] == EMPTYCONTEXT) { $context = $actionlist->[$i+1]; $variable = $actionlist->[$i+2]; substitute_var($context, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Emptying the event store of context '$context'"); } if (!exists($context_list{$context})) { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Context '$context' does not exist, can't empty"); } } else { if (length($variable)) { $value = join("\n", @{$context_list{$context}->{"Buffer"}}); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } $context_list{$context}->{"Buffer"} = []; } $i += 3; } elsif ($actionlist->[$i] == EVENT) { $createafter = $actionlist->[$i+1]; $event = $actionlist->[$i+2]; substitute_var($event, $text); @event = split(/\n/, $event); if (!$createafter) { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Creating event '$event'"); } push @events, @event; } else { foreach $event (@event) { push @pending_events, [ time() + $createafter, $event ]; } } $i += 3; } elsif ($actionlist->[$i] == RESET) { $conffile = $actionlist->[$i+1]; $ruleid = $actionlist->[$i+2]; $event = $actionlist->[$i+3]; substitute_var($event, $text); if (length($ruleid)) { $key = gen_key($conffile, $ruleid, $event); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Cancelling the correlation operation with key '$key'"); } $ref = $configuration{$conffile}->[$ruleid]; if (exists($ref->{"Operations"})) { delete $ref->{"Operations"}->{$key}; } delete $corr_list{$key}; } else { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Cancelling all correlation operations started by rules from", $conffile, "to detect composite event '$event'"); } foreach $ref (@{$configuration{$conffile}}) { $key = gen_key($conffile, $ref->{"ID"}, $event); if (exists($ref->{"Operations"})) { delete $ref->{"Operations"}->{$key}; } delete $corr_list{$key}; } } $i += 4; } elsif ($actionlist->[$i] == ASSIGN) { $variable = $actionlist->[$i+1]; $value = $actionlist->[$i+2]; substitute_var($value, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; $i += 3; } elsif ($actionlist->[$i] == EVAL) { $variable = $actionlist->[$i+1]; $code = $actionlist->[$i+2]; substitute_var($code, $text); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Evaluating code '$code' and setting variable '%$variable'"); } @retval = SEC::call_eval($code, 1); $evalok = shift @retval; if ($evalok) { if (scalar(@retval) > 1) { $value = join("\n", @retval); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } elsif (scalar(@retval) == 1) { $value = $retval[0]; if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } else { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "No value received, leaving variable '%$variable' intact"); } } } else { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Error evaluating code '$code':", $retval[0]); } } $i += 3; } elsif ($actionlist->[$i] == CALL) { $variable = $actionlist->[$i+1]; $code = $actionlist->[$i+2]; @params = @{$actionlist->[$i+3]}; if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Calling code '%$code->()' and setting variable '%$variable'"); } if (ref($variables{$code}) eq "CODE") { foreach $value (@params) { substitute_var($value, $text); } @retval = eval { $variables{$code}->(@params) }; if ($@) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Code '%$code->()' runtime error:", $@); } } else { if (scalar(@retval) > 1) { $value = join("\n", @retval); if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } elsif (scalar(@retval) == 1) { $value = $retval[0]; if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Assigning value '$value' to variable '%$variable'"); } $variables{$variable} = $value; } else { if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "No value received, leaving variable '%$variable' intact"); } } } } else { if ($debuglevel >= LOG_WARN) { log_msg(LOG_WARN, "Variable '%$code' is not a code reference"); } } $i += 4; } elsif ($actionlist->[$i] == MODULE_ACT) { $variable = $actionlist->[$i+1]; substitute_var($variable, $text); $module->action($text, $variable); $i += 2; } } } # Parameters: par1 - context # Action: check if context "par1" is valid at the moment and return 1 # if it is, otherwise return 0. If context "par1" is found to # be stale but is still present in the context list, it will be # removed from there, and if it has an action list, the action # list will be executed. sub valid_context { my($context) = $_[0]; my($alias, @aliases); if (exists($context_list{$context})) { # if the context has infinite lifetime or if its lifetime is not # exceeded, it is valid (TRUE) and return 1 if (!$context_list{$context}->{"Window"}) { return 1; } if (time() - $context_list{$context}->{"Time"} <= $context_list{$context}->{"Window"}) { return 1; } # if the deletion of the context is already in progress (a previous # invocation of valid_context(CONTEXT) has called execute_actionlist() # for the context CONTEXT, which has called valid_context(CONTEXT) # again), then don't call execute_actionlist() for the second time # but return 0 instead. if (exists($context_list{$context}->{"DeleteInProgress"})) { return 0; } # if the context is stale and its action-list-on-delete has not been # executed yet, execute it now if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Deleting stale context '$context'"); } # execute action-list-on-delete if (scalar(@{$context_list{$context}->{"Action"}})) { $context_list{$context}->{"DeleteInProgress"} = 1; execute_actionlist($context_list{$context}->{"Action"}, $context_list{$context}->{"Desc"}); } # remove all names of the context from the list of contexts @aliases = @{$context_list{$context}->{"Aliases"}}; foreach $alias (@aliases) { delete $context_list{$alias}; if ($debuglevel >= LOG_DEBUG) { log_msg(LOG_DEBUG, "Stale context '$alias' deleted"); } } } return 0; } # Parameters: par1 - reference to a context formula # Action: calculate the truth value of the context formula par1; return 1 # if it is TRUE, and return 0 if it is FALSE. sub valid_formula { my($ref) = $_[0]; my($i, $j, $op1, $op2); my($evalresult, $evalok); my(@stack, $retval); $i = 0; $j = scalar(@{$ref}); @stack = (); while ($i < $j) { if ($ref->[$i] == EXPRESSION) { $op1 = $ref->[$i+1]; push @stack, valid_formula($op1); $i += 2; } elsif ($ref->[$i] == ECODE) { $op1 = $ref->[$i+1]; ($evalok, $evalresult) = SEC::call_eval($op1, 0); if ($evalok) { if (defined($evalresult) && $evalresult) { push @stack, 1; } else { push @stack, 0; } } else { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Error evaluating code '$op1': $evalresult"); } push @stack, 0; } $i += 2; } elsif ($ref->[$i] == CCODE) { $op1 = $ref->[$i+1]; $op2 = $ref->[$i+2]; # don't call $op2->($op1), since the valid_formula() function could be # called for the original context expression definition (e.g., # if the rule type is Calendar or if the context expression is in # []-brackets), and passing $op1 to the end user would allow the user # to modify the original context definition $retval = eval { $op2->( ( @{$op1} ) ) }; if ($@) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "Context expression runtime error:", $@); } push @stack, 0; } elsif (defined($retval) && $retval) { push @stack, 1; } else { push @stack, 0; } $i += 3; } elsif ($ref->[$i] == OPERAND) { $op1 = $ref->[$i+1]; if (valid_context($op1)) { push @stack, 1; } else { push @stack, 0; } $i += 2; } elsif ($ref->[$i] == NEGATION) { $op1 = pop @stack; if ($op1) { push @stack, 0; } else { push @stack, 1; } ++$i; } elsif ($ref->[$i] == AND) { $op1 = pop @stack; $op2 = pop @stack; if ($op1 && $op2) { push @stack, 1; } else { push @stack, 0; } ++$i; } elsif ($ref->[$i] == OR) { $op1 = pop @stack; $op2 = pop @stack; if ($op1 || $op2) { push @stack, 1; } else { push @stack, 0; } ++$i; } } return pop @stack; } # Parameters: par1 - number of lines that pattern was designed to match # par2 - pattern (string type) # Action: take par1 last lines from input buffer and concatenate them to # form a single string. Check if par2 is a substring in the formed # string (both par1 and par2 can contain newlines), and return 1 # if it is, otherwise return 0. sub match_substr { my($linecount) = $_[0]; my($substr) = $_[1]; my($line); $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); return (index($line, $substr) != -1); } # Parameters: par1 - number of lines that pattern was designed to match # par2 - pattern (regular expression type) # par3 - reference to an array, where backreference values # $1, $2, .. will be saved. First element of an array will # be $0 that equals to line(s) that were found matching # Action: take par1 last lines from input buffer and concatenate them to # form a single string. Match the formed string with regular # expression par2, and if par2 contains bracketing constructs, # save backreference values $1, $2, .. to array par3. If formed # string matched regular expression, return 1, otherwise return 0 sub match_regexp { my($linecount) = $_[0]; my($regexp) = $_[1]; my($subst_ref) = $_[2]; my($line); $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); if (@{$subst_ref} = ($line =~ /$regexp/)) { unshift @{$subst_ref}, $line; # create $0 that equals to $line return 1; } else { @{$subst_ref} = ( $line ); # create $0 that equals to $line return 0; } } # Parameters: par1 - number of lines that pattern was designed to match # par2 - pattern (perl function type) # par3 - reference to an array, where return values # $1, $2, .. will be saved. First element of an array will # be $0 that equals to line(s) that were found matching # Action: take par1 last lines from input buffer with corresponding source # names, and pass them to the perl function par2->(). # If the function returned value(s), save them as values $1, $2, .. # to array par3. If function returned an empty list or returned # a single value FALSE, return 0, otherwise return 1 sub match_perlfunc { my($linecount) = $_[0]; my($codeptr) = $_[1]; my($subst_ref) = $_[2]; my($line, @lines, @sources); my($size, $match); $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); @lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos]; @sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos]; @{$subst_ref} = eval { $codeptr->(@lines, @sources) }; if ($@) { if ($debuglevel >= LOG_ERR) { log_msg(LOG_ERR, "(N)PerlFunc pattern runtime error:", $@); } @{$subst_ref} = (); } $size = scalar(@{$subst_ref}); $match = $size > 1 || ($size == 1 && $subst_ref->[0]); unshift @{$subst_ref}, $line; # create $0 that equals to $line return $match; } # Parameters: par1 - reference to the array of replacements # par2, par3, .. - strings that will go through replacement # procedure # par n - token that special variables start with # Action: Strings par2, par3, .. will be searched for special variables # (like $0, $1, $2, ..) that will be replaced with 1st, 2nd, .. # element from array par1. If the token symbol is followed by # another token symbol, they will be replaced by a single token # (e.g., $$ -> $). sub subst_string { my($subst_ref) = shift @_; my($token) = pop @_; my($msg, $variable, $length); my($pos, $pos2, $len, $len2); foreach $msg (@_) { $pos2 = 0; $length = length($msg); for (;;) { $pos = index($msg, "$token", $pos2); if ($pos == -1 || $pos == $length - 1) { last; } if (substr($msg, $pos + 1, 1) eq "$token") { substr($msg, $pos, 2) = $token; $pos2 = $pos + 1; --$length; } elsif (substr($msg, $pos + 1) =~ /^(\d+)/) { $variable = $1; $len = length($variable) + 1; if (defined($subst_ref->[$variable])) { substr($msg, $pos, $len) = $subst_ref->[$variable]; $len2 = length($subst_ref->[$variable]); $length += $len2 - $len; $pos2 = $pos + $len2; } else { $pos2 = $pos + $len; } } else { $pos2 = $pos + 1; } if ($pos2 > $length - 1) { last; } } } } # Parameters: par1 - reference to the array of replacements # par2 - reference to a context formula # par3 - token that special variables start with # Action: Context formula par2 will be searched for special variables # (like $1, $2, ..) that will be replaced with 1st, 2nd, .. element # from array par1 sub subst_context { my($subst_ref) = $_[0]; my($ref) = $_[1]; my($token) = $_[2]; my($i, $j); $i = 0; $j = scalar(@{$ref}); while ($i < $j) { if ($ref->[$i] == OPERAND) { subst_string($subst_ref, $ref->[$i+1], $token); $i += 2; } elsif ($ref->[$i] == EXPRESSION) { subst_context($subst_ref, $ref->[$i+1], $token); $i += 2; } elsif ($ref->[$i] == ECODE) { subst_string($subst_ref, $ref->[$i+1], $token); $i += 2; } elsif ($ref->[$i] == CCODE) { subst_string($subst_ref, @{$ref->[$i+1]}, $token); $i += 3; } else { ++$i; } } } # Parameters: par1 - reference to the array of replacements # par2 - reference to action list # par3 - token that special variables start with # Action: action list par2 will be searched for special variables # (like $1, $2, ..) that will be replaced with 1st, 2nd, .. # element from array par1 sub subst_actionlist { my($subst_ref) = $_[0]; my($actionlist) = $_[1]; my($token) = $_[2]; my($subst, @subst_modified); my($i, $j); @subst_modified = @{$subst_ref}; # mask %-signs in substitutions, in order to prevent incorrect # %-variable interpretations foreach $subst (@subst_modified) { if (defined($subst)) { $subst =~ s/%/%%/g; } } $i = 0; $j = scalar(@{$actionlist}); while ($i < $j) { if ($actionlist->[$i] == NONE) { ++$i; } elsif ($actionlist->[$i] == LOGONLY) { ++$i; } elsif ($actionlist->[$i] == WRITE) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == SHELLCOMMAND) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 2; } elsif ($actionlist->[$i] == SPAWN) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 2; } elsif ($actionlist->[$i] == PIPE) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == CREATECONTEXT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_actionlist($subst_ref, $actionlist->[$i+3], $token); $i += 4; } elsif ($actionlist->[$i] == DELETECONTEXT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 2; } elsif ($actionlist->[$i] == OBSOLETECONTEXT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 2; } elsif ($actionlist->[$i] == SETCONTEXT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_actionlist($subst_ref, $actionlist->[$i+3], $token); $i += 4; } elsif ($actionlist->[$i] == ALIAS) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == UNALIAS) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 2; } elsif ($actionlist->[$i] == ADD) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == FILL) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == REPORT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); subst_string(\@subst_modified, $actionlist->[$i+2], $token); $i += 3; } elsif ($actionlist->[$i] == COPYCONTEXT) { subst_string(\@subst_modified, $actionlist->[$i+1], $token); $i += 3; }