#!/usr/bin/perl -w
#
# SEC version 2.3.1 - sec.pl
# simple event correlation tool
#
# Copyright (C) 2000-2005 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_timeout
  $intcontexts
  $intevents
  %int_contexts
  $lastcleanuptime
  $lastconfigload
  $logfile
  @logmsgbuffer
  $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.1";


# 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,
            "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=<file pattern> ...

Optional flags:
  -input=<file pattern>[=<context>] ...
  -input_timeout=<input timeout> 
  -timeout_script=<timeout script>
  -reopen_timeout=<reopen timeout>
  -poll_timeout=<poll timeout>
  -check_timeout=<check timeout>
  -blocksize=<io block size>
  -log=<logfile>
  -syslog=<facility>
  -debug=<debuglevel>
  -pid=<pidfile>
  -dump=<dumpfile>
  -cleantime=<clean time>
  -bufsize=<input buffer size>
  -evstoresize=<event store size>
  -quoting, -noquoting
  -tail, -notail
  -fromstart, -nofromstart
  -detach, -nodetach
  -intevents, -nointevents
  -intcontexts, -nointcontexts
  -testonly, -notestonly

Obsolete flags:
  -separator=<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 DONTCONT		=> 0;
use constant TAKENEXT		=> 1;

use constant NONE		=> 0;
use constant LOGONLY		=> 1;
use constant WRITE		=> 2;
use constant SHELLCOMMAND	=> 3;
use constant SPAWN		=> 4;
use constant PIPE		=> 5;
use constant CREATECONTEXT	=> 6;
use constant DELETECONTEXT	=> 7;
use constant OBSOLETECONTEXT	=> 8;
use constant SETCONTEXT		=> 9;
use constant ALIAS		=> 10;
use constant UNALIAS		=> 11;
use constant ADD		=> 12;
use constant FILL		=> 13;
use constant REPORT		=> 14;
use constant COPYCONTEXT	=> 15;
use constant EMPTYCONTEXT	=> 16;
use constant EVENT		=> 17;
use constant RESET		=> 18;
use constant ASSIGN		=> 19;
use constant EVAL		=> 20;
use constant CALL		=> 21;

use constant OPERAND		=> 0;
use constant NEGATION		=> 1;
use constant AND		=> 2;
use constant OR			=> 3;
use constant EXPRESSION		=> 4;
use constant ECODE		=> 5;
use constant CCODE		=> 6;

use constant EXPRSYMBOL		=> "\0";

use constant LOG_CRIT		=> 1;
use constant LOG_ERR		=> 2;
use constant LOG_WARN		=> 3;
use constant LOG_NOTICE		=> 4;
use constant LOG_INFO		=> 5;
use constant LOG_DEBUG		=> 6;

use constant SYSLOG_LEVELS => {
  1 => "crit",
  2 => "err",
  3 => "warning",
  4 => "notice",
  5 => "info",
  6 => "debug"
};

use constant 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/.*\///;

  Sys::Syslog::openlog($progname, "cons,pid", $facility);

}



# 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;
    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 ($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",
                         "%<letter>[<letter>|<digit>|<underscore>]...");
      }

      return INVALIDVALUE;

    }

    # strip outer parentheses if they exist
    if ($context =~ /^\s*\(\s*(.*)\)\s*$/)  { $context = $1; }

    # remove backslashes in front of the parentheses
    $context =~ s/\\([\(\)])/$1/g;

    return (COPYCONTEXT, $context, substr($variable, 1)); 

  }

  elsif ($action =~ /^empty\s+(\S+)\s*(\S*)\s*$/i) {

    $context = $1;
    $variable = $2;

    if (length($variable)) {

      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",
                           "%<letter>[<letter>|<digit>|<underscore>]...");
        }

        return INVALIDVALUE;

      }

    }

    # strip outer parentheses if they exist
    if ($context =~ /^\s*\(\s*(.*)\)\s*$/)  { $context = $1; }

    # remove backslashes in front of the parentheses
    $context =~ s/\\([\(\)])/$1/g;

    if (!length($variable))  { return (EMPTYCONTEXT, $context, ""); }

    return (EMPTYCONTEXT, $context, substr($variable, 1)); 

  }

  elsif ($action =~ /^event\b\s*(\d*)\b\s*(.*)/i) {

    $createafter = $1;
    $event = $2;

    # strip outer parentheses if they exist
    if ($event =~ /^\s*\(\s*(.*)\)\s*$/)  { $event = $1; }

    # remove backslashes in front of the parentheses
    $event =~ s/\\([\(\)])/$1/g;

    if (!length($createafter))  { $createafter = 0; }
    if (!length($event))  { $event = "%s"; }

    return (EVENT, $createafter, $event); 

  }

  elsif ($action =~ /^reset\b\s*([\+-]?)(\d*)\b\s*(.*)/i) { 

    $sign = $1;
    $rule = $2;
    $event = $3;

    if (length($rule)) {

      if ($sign eq "+") { $rule = $ruleid + $rule; }
      elsif ($sign eq "-") { $rule = $ruleid - $rule; }
      elsif (!$rule) { $rule = $ruleid; } 
      else { --$rule; }

    } else { $rule = ""; }

    # strip outer parentheses if they exist
    if ($event =~ /^\s*\(\s*(.*)\)\s*$/)  { $event = $1; }

    # remove backslashes in front of the parentheses
    $event =~ s/\\([\(\)])/$1/g;

    if (!length($event))  { $event = "%s"; }

    return (RESET, $conffile, $rule, $event); 

  }

  elsif ($action =~ /^assign\s+(\S+)\s*(.*)/i) {

    $variable = $1;
    $value = $2;

    if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                         "Variable $variable does not have the form",
                         "%<letter>[<letter>|<digit>|<underscore>]...");
      }

      return INVALIDVALUE;

    }

    # strip outer parentheses if they exist
    if ($value =~ /^\s*\(\s*(.*)\)\s*$/)  { $value = $1; }

    # remove backslashes in front of the parentheses
    $value =~ s/\\([\(\)])/$1/g;

    if (!length($value))  { $value = "%s"; }

    return (ASSIGN, substr($variable, 1), $value); 

  }

  elsif ($action =~ /^eval\s+(\S+)\s+(.*\S)/i) {

    $variable = $1;
    $code = $2;

    if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                         "Variable $variable does not have the form",
                         "%<letter>[<letter>|<digit>|<underscore>]...");
      }

      return INVALIDVALUE;

    }

    # strip outer parentheses if they exist
    if ($code =~ /^\s*\(\s*(.*)\)\s*$/)  { $code = $1; }

    # remove backslashes in front of the parentheses
    $code =~ s/\\([\(\)])/$1/g;

    return (EVAL, substr($variable, 1), $code); 

  }

  elsif ($action =~ /^call\s+(\S+)\s+(\S+)\s*(.*)/i) {

    $variable = $1;
    $codeptr = $2;
    $params = $3;

    if ($variable !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                         "Variable $variable does not have the form",
                         "%<letter>[<letter>|<digit>|<underscore>]...");
      }

      return INVALIDVALUE;

    }

    if ($codeptr !~ /^%[A-Za-z][A-Za-z0-9_]*$/) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                         "Variable $codeptr does not have the form",
                         "%<letter>[<letter>|<digit>|<underscore>]...");
      }

      return INVALIDVALUE;

    }

    # strip outer parentheses if they exist
    if ($params =~ /^\s*\(\s*(.*)\)\s*$/)  { $params = $1; }

    # remove backslashes in front of the parentheses
    $params =~ s/\\([\(\)])/$1/g;

    return (CALL, substr($variable, 1), 
                  substr($codeptr, 1), [ split(' ', $params) ]); 

  }

  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 = <CONFFILE>;

    # check if the line belongs to previous line; if it does, form a 
    # single line from them and start the loop again (i.e. we will
    # concatenate lines until we read a line that does not end with '\')

    if (defined($linebuf)) {
 
      chomp($linebuf);

      if ($cont)  { $line .= $linebuf; }  else { $line = $linebuf; }

      # remove whitespaces from line beginnings and ends;
      # if line is all-whitespace, set it to empty string

      if ($line =~ /^\s*(.*\S)/)  { $line = $1; }  else { $line = ""; }

      # check if line ends with '\'; if it does, remove '\', set $cont
      # to 1 and jump at the start of loop to read next line, otherwise 
      # set $cont to 0

      if (substr($line, length($line) - 1) eq '\\') { 

        chop($line);
        $cont = 1;
        next;

      } else { $cont = 0; }

    }

    # if the line constructed during previous loop is empty, starting 
    # with #-symbol, or if we have reached EOF, consider that as the end 
    # of current rule. Check the rule and set $rulestart to the next line. 
    # If we have reached EOF, quit the loop, otherwise take the next line.

    if (!defined($linebuf) || !length($line) 
                           || index($line, '#') == 0) { 

      if (scalar(%rule)) { 

        if (check_rule(\%rule, $conffile, $rulestart, $i)) { ++$i; } 
          else { $file_status = 0; }
        %rule = (); 

      }

      $rulestart = $. + 1;
 
      if (defined($linebuf))  { next; }  else { last; }

    }

    # split line into keyword and value

    if ($line =~ /^\s*([A-Za-z0-9]+)\s*=\s*(.*\S)/) {

      $keyword = $1;
      $value = $2;

    } else {

      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

sub substitute_var {

  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)  { last; }

    # 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)  { last; }

  }

}



# 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;

    }

  }

}



# 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;

    }

  }

}



# 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($i, $line);


  $line = "";
  $i = $bufpos - $linecount + 1;

  for (;;) {

    $line .= $input_buffer[$i % $bufsize];

    if ($i == $bufpos)  { return (index($line, $substr) != -1); }

    $line .= "\n";
    ++$i;

  }

}



# 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($i, $line);


  $line = "";
  $i = $bufpos - $linecount + 1;

  for (;;) {

    $line .= $input_buffer[$i % $bufsize];

    if ($i == $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; 

      }

    }

    $line .= "\n";
    ++$i;

  }

}



# 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 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($i, $line, @lines);
  my($size, $match);


  @lines = ();
  $line = "";
  $i = $bufpos - $linecount + 1;

  for (;;) {

    push @lines, $input_buffer[$i % $bufsize];
    $line .= $input_buffer[$i % $bufsize];

    if ($i == $bufpos) {

      @{$subst_ref} = eval { $codeptr->(@lines) };

      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; 

    }

    $line .= "\n";
    ++$i;

  }

}



# Parameters: par1 - reference to the array of replacements
#             par2, par3, .. - strings that will go through replacement
#             procedure
#             par n - token that special variables start with
# Action: Strings par2, par3, .. will be searched for special variables
#         (like $0, $1, $2, ..) that will be replaced with 1st, 2nd, .. 
#         element from array par1. If the token symbol is followed by
#         another token symbol, they will be replaced by a single token 
#         (e.g., $$ -> $).

sub subst_string {

  my($subst_ref) = shift @_;
  my($token) = pop @_;
  my($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
  # %<alnum>-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;
 
    }

    elsif ($actionlist->[$i] == EMPTYCONTEXT) {

      subst_string(\@subst_modified, $actionlist->[$i+1], $token);  
      $i += 3;
 
    }

    elsif ($actionlist->[$i] == EVENT) {
 
      subst_string(\@subst_modified, $actionlist->[$i+2], $token);
      $i += 3;
 
    }

    elsif ($actionlist->[$i] == RESET) {
 
      subst_string(\@subst_modified, $actionlist->[$i+3], $token);
      $i += 4;
 
    }

    elsif ($actionlist->[$i] == ASSIGN) {

      subst_string(\@subst_modified, $actionlist->[$i+2], $token);
      $i += 3;

    }

    elsif ($actionlist->[$i] == EVAL) {

      subst_string(\@subst_modified, $actionlist->[$i+2], $token);
      $i += 3;

    }

    elsif ($actionlist->[$i] == CALL) {

      subst_string(\@subst_modified, @{$actionlist->[$i+3]}, $token);
      $i += 4;

    }

  }

}



# Parameters: par1 - reference to the array of replacements
#             par2, par3, .. - regular expressions that will go through 
#             replacement procedure
#             par n - token that special variables start with
# Action: Regular expressions par2, par3, .. will be searched for special 
#         variables (like $1, $2, ..) that will be replaced with 1st, 
#         2nd, .. element from array par1 

sub subst_regexp {

  my($subst_ref) = shift @_;
  my($token) = pop @_;
  my($subst, @subst_modified);


  @subst_modified = @{$subst_ref};

  foreach $subst (@subst_modified) { 
    if (defined($subst))  { $subst = quotemeta($subst); }
  }

  subst_string(\@subst_modified, @_, $token);

}



# Parameters: par1 - reference to an element from list %corr_list
#             par2 - time
# Action: search event-time list that is associated with element par1,
#         and remove those elements that are obsolete by time par2

sub update_times {

  my($ref) = $_[0];
  my($time) = $_[1];


  while (scalar(@{$ref->{"Times"}})) {

    if ($time - $ref->{"Times"}->[0] <= $ref->{"Window"})  { last; }
    shift @{$ref->{"Times"}};

  }

  if (scalar(@{$ref->{"Times"}})) { 

    $ref->{"Time"} = $ref->{"Times"}->[0];

  } else { $ref->{"Time"} = 0; }

}



# Parameters: par1, par2, .. - strings
# Action: calculate unique key for strings par1, par2, .. that will be
#         used in correlation lists to distinguish between differents events

sub gen_key {

  return join($separator, @_);

}



# Parameters: par1 - name of the configuration file
# Action: search the rules from configuration file par1 and check, if 
#         there is a matching rule for the current content of input buffer.
#         If matching rule is found, new element (that corresponds to
#         an event correlation operation) will be added to the list 
#         %corr_list. Key for new element is calculated by calling gen_key 
#         function:
#           gen_key(file name, rule number, textual description of event)

sub process_rules {

  my($conffile) = $_[0];
  my($key, $ref, $ref2);
  my($time, $match_found, $i);
  my($desc, $pattern2, $desc2);
  my($pid, $script);
  my($below_threshold, $inside_window);
  my($subst, @subst);
  my($context, $context2); 
  my($action, $action2);


  foreach $ref (@{$configuration{$conffile}}) {

    # skip CALENDAR rule

    if ($ref->{"Type"} == CALENDAR)  { next; }

    # check if the rule context expression must be evaluated before 
    # comparing input line(s) with the pattern

    if ($ref->{"ContPreEval"}) {

      # if the value of the context expression is FALSE and the rule is 
      # of type Pair*, look also for all active correlation operations 
      # associated with the current rule and check if 2nd pattern matches

      if (!valid_formula($ref->{"Context"})) {

        if ( ($ref->{"Type"} == PAIR  ||  $ref->{"Type"} == PAIR_W_WINDOW)  
             &&  scalar(%{$ref->{"Operations"}}) ) {

          if (process_rules2($ref)  &&  
              $ref->{"WhatNext2"} == DONTCONT)  { return 1; }

        }

        next;

      }

      $context = $ref->{"Context"};

    }

    # Check if last N lines of input buffer match the pattern
    # specified by rule (value of N is also specified by rule)
    # If match was found, set $match_found to 1
    # If the pattern returned any values, assign them to @subst, 
    # otherwise leave @subst empty

    if ($ref->{"PatType"} == REGEXP) {

      $match_found = 
        match_regexp($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);

    } elsif ($ref->{"PatType"} == SUBSTR) {

      $match_found = match_substr($ref->{"PatLines"}, $ref->{"Pattern"});
      @subst = ();

    } elsif ($ref->{"PatType"} == PERLFUNC) {

      $match_found = 
        match_perlfunc($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);

    } elsif ($ref->{"PatType"} == NREGEXP) {

      $match_found = 
        !match_regexp($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);

    } elsif ($ref->{"PatType"} == NSUBSTR) {

      $match_found = !match_substr($ref->{"PatLines"}, $ref->{"Pattern"});
      @subst = ();

    } elsif ($ref->{"PatType"} == NPERLFUNC) {

      $match_found = 
        !match_perlfunc($ref->{"PatLines"}, $ref->{"Pattern"}, \@subst);

    } elsif ($ref->{"PatType"} == TVALUE) {

      $match_found = $ref->{"Pattern"};
      @subst = ();

    }

    # If match was found, process the event

    if ($match_found) {

      # Evaluate the context expression of the rule

      if (!scalar(@{$ref->{"Context"}}))  { $context = []; }

      elsif (!$ref->{"ContPreEval"}) {

        if (scalar(@subst)) { 

          $context = [];        
          copy_context($ref->{"Context"}, $context); 
          subst_context(\@subst, $context, '$'); 
          
        } else { $context = $ref->{"Context"}; }

        # if the value of the context expression is FALSE and the rule is 
        # of type Pair*, look also for all active correlation operations 
        # associated with the current rule and check if 2nd pattern matches

        if (!valid_formula($context)) {

          if ( ($ref->{"Type"} == PAIR  ||  $ref->{"Type"} == PAIR_W_WINDOW)  
               &&  scalar(%{$ref->{"Operations"}}) ) {

            if (process_rules2($ref)  &&  
                $ref->{"WhatNext2"} == DONTCONT)  { return 1; }

          }

          next;

        }

      }


      # increment the counter that reflects the rule usage
      # (just for statistical purposes)

      ++$ref->{"MatchCount"};


      # ------------------------------------------------------------
      # SINGLE rule
      # ------------------------------------------------------------

      if ($ref->{"Type"} == SINGLE) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst)) { 

          $action = [];
          copy_actionlist($ref->{"Action"}, $action);
          subst_actionlist(\@subst, $action, '$');
          subst_string(\@subst, $desc, '$');
          
        } else { $action = $ref->{"Action"}; }

        execute_actionlist($action, $desc);

      }

      # ------------------------------------------------------------
      # SINGLE_W_SCRIPT rule
      # ------------------------------------------------------------

      elsif ($ref->{"Type"} == SINGLE_W_SCRIPT) {

        $desc = $ref->{"Desc"};
        $script = $ref->{"Script"};

        if (scalar(@subst)) { 

          $action = [];
          $action2 = [];
          copy_actionlist($ref->{"Action"}, $action);
          copy_actionlist($ref->{"Action2"}, $action2);
          subst_actionlist(\@subst, $action, '$');
          subst_actionlist(\@subst, $action2, '$');
          subst_string(\@subst, $desc, $script, '$'); 

        } else {
        
          $action = $ref->{"Action"};
          $action2 = $ref->{"Action2"};
                    
        }

        $pid = pipe_cmd($script, \%context_list);

        if (defined($pid)) {

          $children{$pid}->{"Desc"} = $desc;
          $children{$pid}->{"Action"} = $action; 
          $children{$pid}->{"Action2"} = $action2;

        }

      }

      # ------------------------------------------------------------
      # SINGLE_W_SUPPRESS rule
      # ------------------------------------------------------------

      elsif ($ref->{"Type"} == SINGLE_W_SUPPRESS) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst))  { subst_string(\@subst, $desc, '$'); }

        $key = gen_key($conffile, $ref->{"ID"}, $desc);
        $time = time();

        # if there is no event correlation operation for the key, or 
        # the operation with the key has expired, start the new operation 

        if (!exists($corr_list{$key})  ||
            $time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) {

          if (scalar(@subst)) { 
         
            $action = [];
            copy_actionlist($ref->{"Action"}, $action); 
            subst_actionlist(\@subst, $action, '$'); 
            
          } else { $action = $ref->{"Action"}; }

          $corr_list{$key} = { "Time" => $time, 
                               "Type" => $ref->{"Type"}, 
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Window" => $ref->{"Window"},
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action };

          execute_actionlist($action, $desc);

        }

      }

      # ------------------------------------------------------------
      # PAIR rule
      # ------------------------------------------------------------

      elsif ($ref->{"Type"} == PAIR) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst))  { subst_string(\@subst, $desc, '$'); }

        $key = gen_key($conffile, $ref->{"ID"}, $desc);
        $time = time();

        # if there is no event correlation operation for the key, or 
        # the operation with the key has expired, start the new operation 

        if ( !exists($corr_list{$key})  ||  ($ref->{"Window"}  &&
             $time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) ) {

          $pattern2 = $ref->{"Pattern2"};
          $desc2 = $ref->{"Desc2"};

          if (scalar(@subst)) {

            $action = [];
            copy_actionlist($ref->{"Action"}, $action);
            subst_actionlist(\@subst, $action, '$');

            $action2 = [];
            copy_actionlist($ref->{"Action2"}, $action2);
            
            $context2 = [];
            copy_context($ref->{"Context2"}, $context2);
            
            if ($ref->{"PatType2"} == REGEXP  ||
                $ref->{"PatType2"} == NREGEXP) { 

              subst_regexp(\@subst, $pattern2, '$'); 
              $pattern2 = qr/$pattern2/;

              # mask all $-symbols in substitutions, in order to prevent
              # false interpretations when the second pattern matches

              foreach $subst (@subst) { 
                if (defined($subst))  { $subst =~ s/\$/\$\$/g; }
              }

              subst_string(\@subst, $desc2, '%');
              subst_actionlist(\@subst, $action2, '%');
              subst_context(\@subst, $context2, '%');

            } elsif ($ref->{"PatType2"} == PERLFUNC  ||
                     $ref->{"PatType2"} == NPERLFUNC) { 

              # mask all $-symbols in substitutions, in order to prevent
              # false interpretations when the second pattern matches

              foreach $subst (@subst) { 
                if (defined($subst))  { $subst =~ s/\$/\$\$/g; }
              }

              subst_string(\@subst, $desc2, '%');
              subst_actionlist(\@subst, $action2, '%');
              subst_context(\@subst, $context2, '%');

            } elsif ($ref->{"PatType2"} == SUBSTR  ||
                     $ref->{"PatType2"} == NSUBSTR) { 
            
              subst_string(\@subst, $pattern2, $desc2, '$');
              subst_actionlist(\@subst, $action2, '$');
              subst_context(\@subst, $context2, '$');
              
            } else {

              subst_string(\@subst, $desc2, '$');
              subst_actionlist(\@subst, $action2, '$');
              subst_context(\@subst, $context2, '$');

            }

          } else {
          
            $action = $ref->{"Action"};
            $action2 = $ref->{"Action2"};
            $context2 = $ref->{"Context2"};

          }
          
          $corr_list{$key} = { "Time" => $time,
                               "Type" => $ref->{"Type"},
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Window" => $ref->{"Window"},
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action,
                               "Pattern2" => $pattern2, 
                               "Context2" => $context2,
                               "Desc2" => $desc2,
                               "Action2" => $action2 };

          $ref->{"Operations"}->{$key} = $corr_list{$key};

          execute_actionlist($action, $desc);

        }

      }

      # ------------------------------------------------------------
      # PAIR_W_WINDOW rule
      # ------------------------------------------------------------

      elsif ($ref->{"Type"} == PAIR_W_WINDOW) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst))  { subst_string(\@subst, $desc, '$'); }

        $key = gen_key($conffile, $ref->{"ID"}, $desc);
        $time = time();

        # if there is an event correlation operation for the key and 
        # the operation has expired, execute the first action list and 
        # terminate the operation

        if ( exists($corr_list{$key})  &&
             $time - $corr_list{$key}->{"Time"} > $ref->{"Window"} ) {

          execute_actionlist($corr_list{$key}->{"Action"}, $desc);

          delete $corr_list{$key};
          delete $ref->{"Operations"}->{$key};

        }

        # if there is no event correlation operation for the key,
        # start the new operation 

        if (!exists($corr_list{$key})) {

          $pattern2 = $ref->{"Pattern2"};
          $desc2 = $ref->{"Desc2"};

          if (scalar(@subst)) {

            $action = [];
            copy_actionlist($ref->{"Action"}, $action);
            subst_actionlist(\@subst, $action, '$');

            $action2 = [];
            copy_actionlist($ref->{"Action2"}, $action2);
                        
            $context2 = [];
            copy_context($ref->{"Context2"}, $context2);
                                                
            if ($ref->{"PatType2"} == REGEXP  ||
                $ref->{"PatType2"} == NREGEXP) { 

              subst_regexp(\@subst, $pattern2, '$'); 
              $pattern2 = qr/$pattern2/;

              # mask all $-symbols in substitutions, in order to prevent
              # false interpretations when the second pattern matches

              foreach $subst (@subst) { 
                if (defined($subst))  { $subst =~ s/\$/\$\$/g; }
              }

              subst_string(\@subst, $desc2, '%');
              subst_actionlist(\@subst, $action2, '%');
              subst_context(\@subst, $context2, '%');

            } elsif ($ref->{"PatType2"} == PERLFUNC  ||
                     $ref->{"PatType2"} == NPERLFUNC) { 

              # mask all $-symbols in substitutions, in order to prevent
              # false interpretations when the second pattern matches

              foreach $subst (@subst) { 
                if (defined($subst))  { $subst =~ s/\$/\$\$/g; }
              }

              subst_string(\@subst, $desc2, '%');
              subst_actionlist(\@subst, $action2, '%');
              subst_context(\@subst, $context2, '%');

            } elsif ($ref->{"PatType2"} == SUBSTR  ||
                     $ref->{"PatType2"} == NSUBSTR) { 
            
              subst_string(\@subst, $pattern2, $desc2, '$');
              subst_actionlist(\@subst, $action2, '$');
              subst_context(\@subst, $context2, '$');
              
            } else { 

              subst_string(\@subst, $desc2, '$'); 
              subst_actionlist(\@subst, $action2, '$');
              subst_context(\@subst, $context2, '$');

            }

          } else {

            $action = $ref->{"Action"};
            $action2 = $ref->{"Action2"};
            $context2 = $ref->{"Context2"};
          
          }

          $corr_list{$key} = { "Time" => $time, 
                               "Type" => $ref->{"Type"},
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Window" => $ref->{"Window"}, 
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action, 
                               "Pattern2" => $pattern2, 
                               "Context2" => $context2,
                               "Desc2" => $desc2,
                               "Action2" => $action2 };

          $ref->{"Operations"}->{$key} = $corr_list{$key};

        }

      }

      # ------------------------------------------------------------
      # SINGLE_W_THRESHOLD rule
      # ------------------------------------------------------------ 

      elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst))  { subst_string(\@subst, $desc, '$'); }

        $key = gen_key($conffile, $ref->{"ID"}, $desc);
        $time = time();

        # if there is no event correlation operation for the key,
        # start the new operation 

        if (!exists($corr_list{$key})) {

          if (scalar(@subst)) { 
         
            $action = [];
            copy_actionlist($ref->{"Action"}, $action); 
            subst_actionlist(\@subst, $action, '$'); 
            
          } else { $action = $ref->{"Action"}; }

          $corr_list{$key} = { "Time" => $time, 
                               "Type" => $ref->{"Type"},
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Times" => [], 
                               "Window" => $ref->{"Window"},
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action,
                               "Threshold" => $ref->{"Threshold"} };

        } 

        $ref2 = $corr_list{$key};

        # inside_window - TRUE if we are still in time window
        # below_threshold - TRUE if we were below threshold before this event

        $inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window"});
        $below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold"});

        if ($inside_window  &&  $below_threshold) {

          # if we are inside time window and below threshold, increase 
          # the counter, and if new value of the counter equals to threshold, 
          # execute the action list

          push @{$ref2->{"Times"}}, $time;

          if (scalar(@{$ref2->{"Times"}}) == $ref->{"Threshold"}) {

            execute_actionlist($ref2->{"Action"}, $desc);

          }

        } 

        elsif ($below_threshold) {

          # if we are already outside time window but still below
          # threshold, slide the window forward

          push @{$ref2->{"Times"}}, $time;

          update_times($ref2, $time);

        }

        elsif (!$inside_window) {

          # if we are both outside time window and above threshold, then 
          # action list was executed in the past and this event correlation 
          # operation was used to suppress post-action events; since
          # the operation has expired, terminate it and start the new one,
          # because the event we have received matches the rule.

          if (scalar(@subst)) { 
          
            $action = [];
            copy_actionlist($ref->{"Action"}, $action);
            subst_actionlist(\@subst, $action, '$');
            
          } else { $action = $ref->{"Action"}; }

          $corr_list{$key} = { "Time" => $time, 
                               "Type" => $ref->{"Type"},
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Times" => [ $time ], 
                               "Window" => $ref->{"Window"},
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action,
                               "Threshold" => $ref->{"Threshold"} };

          if ($ref->{"Threshold"} == 1) { 

            execute_actionlist($action, $desc); 

          }

        } 

      }

      # ------------------------------------------------------------
      # SINGLE_W_2_THRESHOLDS rule
      # ------------------------------------------------------------ 

      elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {

        $desc = $ref->{"Desc"};

        if (scalar(@subst))  { subst_string(\@subst, $desc, '$'); }

        $key = gen_key($conffile, $ref->{"ID"}, $desc);
        $time = time();

        # if there is no event correlation operation for the key,
        # start the new operation 

        if (!exists($corr_list{$key})) {

          $desc2 = $ref->{"Desc2"};

          if (scalar(@subst)) { 

            $action = [];
            $action2 = [];
            copy_actionlist($ref->{"Action"}, $action);
            copy_actionlist($ref->{"Action2"}, $action2);
            subst_actionlist(\@subst, $action, '$');
            subst_actionlist(\@subst, $action2, '$');
            subst_string(\@subst, $desc2, '$');

          } else {
          
            $action = $ref->{"Action"};
            $action2 = $ref->{"Action2"};
            
          }

          $corr_list{$key} = { "Time" => $time, 
                               "Type" => $ref->{"Type"},
                               "File" => $conffile,
                               "ID" => $ref->{"ID"},
                               "Times" => [], 
                               "Window" => $ref->{"Window"}, 
                               "Context" => $context,
                               "Desc" => $desc,
                               "Action" => $action,
                               "Threshold" => $ref->{"Threshold"}, 
                               "2ndPass" => 0,
                               "Window2" => $ref->{"Window2"}, 
                               "Threshold2" => $ref->{"Threshold2"}, 
                               "Desc2" => $desc2,
                               "Action2" => $action2 };

        } 

        $ref2 = $corr_list{$key};

        # ----- if we are still checking 1st threshold...

        if (!$ref2->{"2ndPass"}) {

          # inside_window - TRUE if we are still in time window
          # below_threshold - TRUE if we were below threshold before this event

          $inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window"});
          $below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold"});

          if ($inside_window) {

            # if we are inside time window, increase the counter, and
            # if new value of the counter equals to threshold, execute
            # the action list and start to check 2nd threshold

            push @{$ref2->{"Times"}}, $time;

            if (scalar(@{$ref2->{"Times"}}) == $ref->{"Threshold"}) {

              $ref2->{"Time"} = $time;
              $ref2->{"2ndPass"} = 1;
              $ref2->{"Times"} = [];

              execute_actionlist($ref2->{"Action"}, $desc);

            }

          } 

          elsif ($below_threshold) {

            # if we are already outside time window but still below
            # threshold, slide the window forward

            push @{$ref2->{"Times"}}, $time;

            update_times($ref2, $time);

          }

        # ----- if we are already checking 2nd threshold...

        } else {

          # inside_window - TRUE if we are still in time window
          # below_threshold - TRUE if we were below threshold before this event

          $inside_window = ($time - $ref2->{"Time"} <= $ref->{"Window2"});
          $below_threshold = (scalar(@{$ref2->{"Times"}}) < $ref->{"Threshold2"});

          if ($inside_window  &&  $below_threshold) {

            # if we are both inside time window and below threshold,
            # we can increase the counter (this threshold is considered
            # as crossed if counter > threshold, counter == threshold
            # is still permitted).

            push @{$ref2->{"Times"}}, $time;

          }

          elsif ($inside_window) {

            # if we are inside the time window and below_threshold == FALSE
            # then together with current event we have crossed the threshold
            # (counter > threshold). So we have to slide the window.

            if ($ref->{"Threshold2"}) {

              shift @{$ref2->{"Times"}};
              push @{$ref2->{"Times"}}, $time;

              $ref2->{"Time"} = $ref2->{"Times"}->[0];

            } else { $ref2->{"Time"} = $time; }

          } 

          else {

            # if we have reached here, we must be outside time window
            # and also below threshold, since threshold crossing would
            # have already been detected by previous code block.
            # So we can execute the action list.

            execute_actionlist($ref2->{"Action2"}, $ref2->{"Desc2"});

            # since action was just executed we can terminate this event
            # correlation operation and start the new one, because the event
            # we have received matches the rule.
            
            $desc2 = $ref->{"Desc2"};

            if (scalar(@subst)) { 

              $action = [];
              $action2 = [];
              copy_actionlist($ref->{"Action"}, $action);
              copy_actionlist($ref->{"Action2"}, $action2);
              subst_actionlist(\@subst, $action, '$');
              subst_actionlist(\@subst, $action2, '$');
              subst_string(\@subst, $desc2, '$');

            } else {
            
              $action = $ref->{"Action"};
              $action2 = $ref->{"Action2"};
              
            }

            $corr_list{$key} = { "Time" => $time, 
                                 "Type" => $ref->{"Type"},
                                 "File" => $conffile,
                                 "ID" => $ref->{"ID"},
                                 "Times" => [ $time ], 
                                 "Window" => $ref->{"Window"}, 
                                 "Context" => $context,
                                 "Desc" => $desc,
                                 "Action" => $action,
                                 "Threshold" => $ref->{"Threshold"}, 
                                 "2ndPass" => 0,
                                 "Window2" => $ref->{"Window2"}, 
                                 "Threshold2" => $ref->{"Threshold2"}, 
                                 "Desc2" => $desc2,
                                 "Action2" => $action2 };

            if ($ref->{"Threshold"} == 1) {

              $corr_list{$key}->{"2ndPass"} = 1;
              $corr_list{$key}->{"Times"} = [];

              execute_actionlist($action, $desc);

            }

          }

        }

      }

      # ------------------------------------------------------------
      # SUPPRESS rule
      # ------------------------------------------------------------

      elsif ($ref->{"Type"} == SUPPRESS)  { return 1; }

      # ------------------------------------------------------------

      # if match was found and rule's continue-parameter
      # is set to DontCont, return 1, otherwise return 0

      if ($ref->{"WhatNext"} == DONTCONT)  { return 1; }

    } else {

      # if match was not found and rule is of type Pair*, look also for 
      # all active correlation operations associated with the current 
      # rule and check if 2nd pattern matches

      if ( ($ref->{"Type"} == PAIR  ||  $ref->{"Type"} == PAIR_W_WINDOW)  
           &&  scalar(%{$ref->{"Operations"}}) ) {

        if (process_rules2($ref)  &&  
            $ref->{"WhatNext2"} == DONTCONT)  { return 1; }

      }

    }

  }

  return 0;

}



# Parameters: par1 - reference to a rule
# Action: search the event correlation operations associated with Pair*
#         rules and check, if there is a matching event for the current 
#         content of input buffer. If there were 1 or more matches found, 
#         return 1, otherwise return 0

sub process_rules2 {

  my($elem) = $_[0];
  my($key, $ref, $ret);
  my($match_found, @subst);
  my($type, $window);
  my($pattype2, $patlines2, $desc2);
  my($context2, $action2);


  $ret = 0;   # shows if matches were found

  $type = $elem->{"Type"};
  $pattype2 = $elem->{"PatType2"};
  $patlines2 = $elem->{"PatLines2"};
  $window = $elem->{"Window"};

  foreach $key (keys %{$elem->{"Operations"}}) {

    if (!exists($elem->{"Operations"}->{$key}))  { next; }

    $ref = $elem->{"Operations"}->{$key};

    # check if the rule context expression must be evaluated before
    # comparing input line(s) with the pattern

    if ($elem->{"ContPreEval2"}) {

      if (!valid_formula($ref->{"Context2"}))  { next; }  

    }

    # Check if last N lines of input buffer match the pattern
    # If match was found, set $match_found to 1
    # If the pattern returned any values, assign them to @subst,
    # otherwise leave @subst empty

    if ($pattype2 == REGEXP) {

      $match_found = 
        match_regexp($patlines2, $ref->{"Pattern2"}, \@subst);

    } elsif ($pattype2 == SUBSTR) {

      $match_found = match_substr($patlines2, $ref->{"Pattern2"});
      @subst = ();

    } elsif ($pattype2 == PERLFUNC) {

      $match_found = 
        match_perlfunc($patlines2, $ref->{"Pattern2"}, \@subst);

    } elsif ($pattype2 == NREGEXP) {

      $match_found = 
        !match_regexp($patlines2, $ref->{"Pattern2"}, \@subst);

    } elsif ($pattype2 == NSUBSTR) {

      $match_found = !match_substr($patlines2, $ref->{"Pattern2"});
      @subst = ();

    } elsif ($pattype2 == NPERLFUNC) {

      $match_found = 
        !match_perlfunc($patlines2, $ref->{"Pattern2"}, \@subst);

    } elsif ($pattype2 == TVALUE) {

      $match_found = $ref->{"Pattern2"};
      @subst = ();

    }

    # If match was found, process the event

    if ($match_found) {

      # Evaluate the context expression of the rule

      if (scalar(@{$ref->{"Context2"}})  &&  !$elem->{"ContPreEval2"}) {

        if (scalar(@subst)) { 
       
          $context2 = [];
          copy_context($ref->{"Context2"}, $context2); 
          subst_context(\@subst, $context2, '$'); 
          
        } else { $context2 = $ref->{"Context2"}; }

        if (!valid_formula($context2))  { next; }  

      }


      # --- PAIR rule

      if ($type == PAIR) {

        # if we are inside time window, execute 2nd action list

        if (!$window  ||  time() - $ref->{"Time"} <= $window) {

          $ret = 1;
          ++$elem->{"MatchCount"};

          $desc2 = $ref->{"Desc2"};

          if (scalar(@subst)) { 

            $action2 = [];
            copy_actionlist($ref->{"Action2"}, $action2);
            subst_actionlist(\@subst, $action2, '$');
            subst_string(\@subst, $desc2, '$'); 

          } else { $action2 = $ref->{"Action2"}; }

          execute_actionlist($action2, $desc2);

        }

        # now we can terminate this event correlation operation,
        # since we have seen the event that matches the second pattern

        delete $corr_list{$key};
        delete $elem->{"Operations"}->{$key};

      }

      # --- PAIR_W_WINDOW rule

      elsif ($type == PAIR_W_WINDOW) {

        # we can terminate this event correlation operation,
        # since we have seen the event that matches the second pattern
        # (in order to achieve good event ordering, execute 2nd action
        # list without checking the window)

        $ret = 1;
        ++$elem->{"MatchCount"};

        $desc2 = $ref->{"Desc2"};

        if (scalar(@subst)) { 

          $action2 = [];
          copy_actionlist($ref->{"Action2"}, $action2);
          subst_actionlist(\@subst, $action2, '$');
          subst_string(\@subst, $desc2, '$'); 

        } else { $action2 = $ref->{"Action2"}; }

        execute_actionlist($action2, $desc2);

        delete $corr_list{$key};
        delete $elem->{"Operations"}->{$key};

      }

    }
    
  }

  # if there were 1 or more matches found, return 1, otherwise return 0

  return $ret;

}



# Parameters: -
# Action: search lists %corr_list, %context_list, @calendar and 
#         @pending_events, performing timed tasks that are associated 
#         with elements and removing obsolete elements

sub process_lists {

  my($key, $ref, $config);
  my($time, $diff, $lastdayofmonth);
  my(@time, $event, @buffer);
  my($minute, $hour, $day, $month, $weekday);


  # remove obsolete elements from %context_list

  foreach $key (keys %context_list)  { valid_context($key); }

  # move pending events that have become relevant from 
  # @pending_events list to @events list

  if (scalar(@pending_events)) {

    @buffer = ();

    foreach $ref (@pending_events) {

      if (time() >= $ref->[0]) {

        $event = $ref->[1];

        if ($debuglevel >= LOG_DEBUG) {
          log_msg(LOG_DEBUG, "Creating event '$event'");
        }

        push @events, $event;

      } else { push @buffer, $ref; }

    }  

    @pending_events = @buffer;

  }

  # process CALENDAR rules

  @time = localtime(time());
  $minute = $time[1];
  $hour = $time[2];
  $day = $time[3];
  $month = $time[4];
  $weekday = $time[6];

  $lastdayofmonth = ((localtime(time()+86400))[3] == 1);

  foreach $ref (@calendar) {

    # if we have already performed this task in current minute, skip

    if ($minute == $ref->{"LastMinute"} && 
        $hour == $ref->{"LastHour"} &&
        $day == $ref->{"LastDay"} && 
        $month == $ref->{"LastMonth"} &&
        $weekday == $ref->{"LastWeekday"})  { next; }

    # if one of the time conditions does not hold, skip

    if (!exists($ref->{"Minutes"}->{$minute}))  { next; }
    if (!exists($ref->{"Hours"}->{$hour}))  { next; }
 
    if ( !exists($ref->{"Days"}->{$day}) &&
         !($lastdayofmonth && exists($ref->{"Days"}->{"0"}))
       )  { next; } 

    if (!exists($ref->{"Months"}->{$month}))  { next; }
    if (!exists($ref->{"Weekdays"}->{$weekday}))  { next; }

    # check the context expression of the rule
    
    if (scalar(@{$ref->{"Context"}})) {

      if (!valid_formula($ref->{"Context"}))  { next; }  

    }

    # execute the action list of the calendar event 
    # and save current time

    execute_actionlist($ref->{"Action"}, $ref->{"Desc"});

    $ref->{"LastMinute"} = $minute;
    $ref->{"LastHour"} = $hour;
    $ref->{"LastDay"} = $day;
    $ref->{"LastMonth"} = $month;
    $ref->{"LastWeekday"} = $weekday;

    ++$ref->{"MatchCount"};

  }

  # perform timed tasks that are associated with elements of
  # %corr_list and remove obsolete elements

  foreach $key (keys %corr_list) {

    if (!exists($corr_list{$key}))  { next; }

    $ref = $corr_list{$key};

    $time = time();
    $diff = $time - $ref->{"Time"};
    $config = $configuration{$ref->{"File"}}->[$ref->{"ID"}];

    # ------------------------------------------------------------ 
    # SINGLE_W_SUPPRESS rule
    # ------------------------------------------------------------ 

    if ($ref->{"Type"} == SINGLE_W_SUPPRESS) {

      # if we are outside time window, list element is obsolete
      # and can be removed 

      if ($diff > $ref->{"Window"})  { delete $corr_list{$key}; }

    }

    # ------------------------------------------------------------ 
    # PAIR rule
    # ------------------------------------------------------------ 

    elsif ($ref->{"Type"} == PAIR) {

      # if we are outside time window, list elements are obsolete
      # and can be removed 

      if ($ref->{"Window"}  &&  $diff > $ref->{"Window"}) {

        delete $corr_list{$key};
        delete $config->{"Operations"}->{$key};
      
      }

    }

    # ------------------------------------------------------------ 
    # PAIR_W_WINDOW rule
    # ------------------------------------------------------------ 

    elsif ($ref->{"Type"} == PAIR_W_WINDOW) {

      # if we are outside time window, 1st action must be executed;
      # after that the list elements are obsolete and can be removed 

      if ($diff > $ref->{"Window"}) {

        execute_actionlist($ref->{"Action"}, $ref->{"Desc"});

        delete $corr_list{$key};
        delete $config->{"Operations"}->{$key};

      }

    }

    # ------------------------------------------------------------ 
    # SINGLE_W_THRESHOLD rule
    # ------------------------------------------------------------ 

    elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {

      if ($diff > $ref->{"Window"}) {

        if (scalar(@{$ref->{"Times"}}) < $ref->{"Threshold"}) {

          # If we are outside time window and threshold is not exceeded, 
          # try to slide the window. If all events are gone after sliding,
          # remove the list element as obsolete.

          update_times($ref, $time);

          if (!scalar(@{$ref->{"Times"}}))  { delete $corr_list{$key}; }

        } else {

          # If we are outside time window and threshold is exceeded, 
          # remove the list element as obsolete.

          delete $corr_list{$key};

        }

      }

    }

    # ------------------------------------------------------------ 
    # SINGLE_W_2_THRESHOLDS rule
    # ------------------------------------------------------------ 

    elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {

      if (!$ref->{"2ndPass"}) {

        # If we are outside 1st time window, try to slide the window.
        # If all events are gone after sliding, remove the list element 
        # as obsolete

        if ($diff > $ref->{"Window"}) {

          update_times($ref, $time);

          if (!scalar(@{$ref->{"Times"}}))  { delete $corr_list{$key}; }

        }

      } else {

        # If we are outside 2nd time window and list element
        # has not been removed, we can conclude that 2nd threshold was
        # not exceeded, and so 2nd action can be executed.
        # After that the list element can be removed as obsolete.

        if ($diff > $ref->{"Window2"}) {

          execute_actionlist($ref->{"Action2"}, $ref->{"Desc2"});

          delete $corr_list{$key};

        }

      }

    }


  }

}



#################################################
# Functions related to reporting and data dumping
#################################################


# Parameters: par1 - reference to a action list
# Action: convert action list to a string representation

sub actionlist2str {

  my($actionlist) = $_[0];
  my($i, $j);
  my($result);


  $i = 0;
  $j = scalar(@{$actionlist});
  $result = "";

  while ($i < $j) {

    if ($actionlist->[$i] == NONE) { 

      $result .= "none"; 
      ++$i;

    }

    elsif ($actionlist->[$i] == LOGONLY) { 

      $result .= "logonly"; 
      ++$i;

    } 

    elsif ($actionlist->[$i] == WRITE) {

      $result .= "write " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
 
    }

    elsif ($actionlist->[$i] == SHELLCOMMAND) { 

      $result .= "shellcmd " . $actionlist->[$i+1]; 
      $i += 2;

    } 

    elsif ($actionlist->[$i] == SPAWN) { 

      $result .= "spawn " . $actionlist->[$i+1]; 
      $i += 2;

    } 

    elsif ($actionlist->[$i] == PIPE) {

      $result .= "pipe " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
 
    }

    elsif ($actionlist->[$i] == CREATECONTEXT) { 

      $result .= "create " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];

      if (scalar(@{$actionlist->[$i+3]})) {

        $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";

      }

      $i += 4; 

    } 

    elsif ($actionlist->[$i] == DELETECONTEXT) { 

      $result .= "delete " . $actionlist->[$i+1]; 
      $i += 2;

    } 

    elsif ($actionlist->[$i] == OBSOLETECONTEXT) { 

      $result .= "obsolete " . $actionlist->[$i+1]; 
      $i += 2;

    } 

    elsif ($actionlist->[$i] == SETCONTEXT) {
 
      $result .= "set " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];

      if (scalar(@{$actionlist->[$i+3]})) {

        $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";

      }

      $i += 4;
 
    }

    elsif ($actionlist->[$i] == ALIAS) { 

      $result .= "alias " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == UNALIAS) { 

      $result .= "unalias " . $actionlist->[$i+1]; 
      $i += 2;

    }

    elsif ($actionlist->[$i] == ADD) { 

      $result .= "add " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == FILL) { 

      $result .= "fill " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == REPORT) { 

      $result .= "report " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == COPYCONTEXT) { 

      $result .= "copy " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == EMPTYCONTEXT) { 

      if (length($actionlist->[$i+2])) {

        $result .= "empty " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];

      } else {

        $result .= "empty " . $actionlist->[$i+1];

      }

      $i += 3;

    }

    elsif ($actionlist->[$i] == EVENT) { 

      $result .= "event " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == RESET) { 

      $result .= "reset " . $actionlist->[$i+2] . " " . $actionlist->[$i+3]; 
      $i += 4;

    }

    elsif ($actionlist->[$i] == ASSIGN) { 

      $result .= "assign %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == EVAL) { 

      $result .= "eval %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 
      $i += 3;

    }

    elsif ($actionlist->[$i] == CALL) { 

      $result .= "call %" . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]
                 . " " . join(" ", @{$actionlist->[$i+3]}); 
      $i += 4;

    }

    else { $result .= "unknown action type"; }

    $result .= "; ";

  }

  return $result;

}



# Parameters: par1 - pattern type
#             par2 - pattern lines
#             par3 - pattern
# Action: convert pattern to a printable representation

sub pattern2str {

  my($type) = $_[0];
  my($lines) = $_[1];
  my($pattern) = $_[2];
  

  if ($type == SUBSTR) { 
    return "substring for $lines line(s): $pattern"; 
  } 

  elsif ($type == REGEXP) {
    return "regexp for $lines line(s): $pattern";
  } 

  elsif ($type == PERLFUNC) {
    return "perlfunc for $lines line(s): $pattern";
  } 

  elsif ($type == NSUBSTR) { 
    return "negative substring for $lines line(s): $pattern"; 
  } 

  elsif ($type == NREGEXP) {
    return "negative regexp for $lines line(s): $pattern";
  } 

  elsif ($type == NPERLFUNC) {
    return "negative perlfunc for $lines line(s): $pattern";
  } 

  elsif ($type == TVALUE) {
    return "truth value: " . ($pattern?"TRUE":"FALSE");
  } 

  else { return "Unknown pattern type"; }

}



# Parameters: par1 - reference to a context formula
# Action: convert given context to a printable representation

sub context2str {

  my($ref) = $_[0];
  my($i, $j, $op1, $op2);
  my(@stack, $result);


  $i = 0;
  $j = scalar(@{$ref});
  @stack = ();

  while ($i < $j) {

    if ($ref->[$i] == EXPRESSION) {

      $op1 = $ref->[$i+1];
      push @stack, "(" . context2str($op1) . ")";

      $i += 2;
    }

    elsif ($ref->[$i] == ECODE) {

      $op1 = $ref->[$i+1];
      push @stack, "=( " . $op1 . " )";

      $i += 2;
    }

    elsif ($ref->[$i] == CCODE) {

      $op1 = $ref->[$i+1];
      $op2 = $ref->[$i+2];
      push @stack, join(" ", @{$op1}) . " -> " . $op2;

      $i += 3;
    }

    elsif ($ref->[$i] == OPERAND) {

      $op1 = $ref->[$i+1];
      push @stack, $op1;

      $i += 2;
    }

    elsif ($ref->[$i] == NEGATION) {

      $op1 = pop @stack;
      push @stack, "!" . $op1;

      ++$i;
    }

    elsif ($ref->[$i] == AND) {

      $op2 = pop @stack;
      $op1 = pop @stack;

      push @stack, $op1 . " && " . $op2;

      ++$i;
    }

    elsif ($ref->[$i] == OR) {

      $op2 = pop @stack;
      $op1 = pop @stack;

      push @stack, $op1 . " || " . $op2;

      ++$i;
    }

  }

  $result = pop @stack;

  if (!defined($result))  { $result = ""; }

  return $result;

}



# Parameters: par1 - filehandle
#             par2 - list element key
#             par3 - reference to list element
# Action: print given list element to the filehandle

sub print_element {

  my($handle) = $_[0];
  my($key) = $_[1];
  my($ref) = $_[2];
  my($config, $conffile, $id, $time);


  print $handle "Key:\t\t\t\t", $key, "\n";
  print $handle "Start of correlation operation:\t", 
                scalar(localtime($ref->{"Time"})), "\n";

  $conffile = $ref->{"File"};
  $id = $ref->{"ID"};
  $config = $configuration{$conffile}->[$id];

  print $handle "Configuration file:\t\t", $conffile, "\n";
  print $handle "Rule number:\t\t\t", $id+1, "\n";
  print $handle "Rule internal ID:\t\t", $id, "\n";

  if ($ref->{"Type"} == SINGLE_W_SUPPRESS) {

    print $handle "Type:\t\t\t\t";
    print $handle "SingleWithSuppress\n";

    if ($config->{"WhatNext"} == DONTCONT) {
      print $handle "Behaviour after match:\t\t", "don't continue\n";
    } else {
      print $handle "Behaviour after match:\t\t", "take next\n";
    }

    print $handle "Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType"},
                  $config->{"PatLines"}, $config->{"Pattern"});
    print $handle "\n";

    print $handle "Context:\t\t\t";
    print $handle context2str($ref->{"Context"});
    print $handle "\n";

    print $handle "Event:\t\t\t\t", $ref->{"Desc"}, "\n";

    print $handle "Action:\t\t\t\t";
    print $handle actionlist2str($ref->{"Action"});
    print $handle "\n";

    print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";

    print $handle "\n";

  }

  elsif ($ref->{"Type"} == PAIR) {

    print $handle "Type:\t\t\t\t";
    print $handle "Pair\n";

    if ($config->{"WhatNext"} == DONTCONT) {
      print $handle "Behaviour after 1st match:\t", "don't continue\n";
    } else {
      print $handle "Behaviour after 1st match:\t", "take next\n";
    }

    print $handle "1st Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType"},
                  $config->{"PatLines"}, $config->{"Pattern"});
    print $handle "\n";

    print $handle "1st Context:\t\t\t";
    print $handle context2str($ref->{"Context"});
    print $handle "\n";

    print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";

    print $handle "1st Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action"});
    print $handle "\n";

    if ($config->{"WhatNext2"} == DONTCONT) {
      print $handle "Behaviour after 2nd match:\t", "don't continue\n";
    } else {
      print $handle "Behaviour after 2nd match:\t", "take next\n";
    }

    print $handle "2nd Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType2"},
                  $config->{"PatLines2"}, $ref->{"Pattern2"});
    print $handle "\n";

    print $handle "2nd Context:\t\t\t";
    print $handle context2str($ref->{"Context2"});
    print $handle "\n";

    print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";

    print $handle "2nd Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action2"});
    print $handle "\n";

    if ($ref->{"Window"}) {
      print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";
    } else {
      print $handle "Window:\t\t\t\t", "infinite\n";
    }

    print $handle "\n";

  }

  elsif ($ref->{"Type"} == PAIR_W_WINDOW) {

    print $handle "Type:\t\t\t\t";
    print $handle "PairWithWindow\n";

    if ($config->{"WhatNext"} == DONTCONT) {
      print $handle "Behaviour after 1st match:\t", "don't continue\n";
    } else {
      print $handle "Behaviour after 1st match:\t", "take next\n";
    }

    print $handle "1st Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType"},
                  $config->{"PatLines"}, $config->{"Pattern"});
    print $handle "\n";

    print $handle "Context:\t\t\t";
    print $handle context2str($ref->{"Context"});
    print $handle "\n";

    print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";

    print $handle "1st Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action"});
    print $handle "\n";

    if ($config->{"WhatNext2"} == DONTCONT) {
      print $handle "Behaviour after 2nd match:\t", "don't continue\n";
    } else {
      print $handle "Behaviour after 2nd match:\t", "take next\n";
    }

    print $handle "2nd Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType2"},
                  $config->{"PatLines2"}, $ref->{"Pattern2"});
    print $handle "\n";

    print $handle "2nd Context:\t\t\t";
    print $handle context2str($ref->{"Context2"});
    print $handle "\n";

    print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";

    print $handle "2nd Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action2"});
    print $handle "\n";

    print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";

    print $handle "\n";

  }

  elsif ($ref->{"Type"} == SINGLE_W_THRESHOLD) {

    print $handle "Type:\t\t\t\t";
    print $handle "SingleWithThreshold\n";

    if ($config->{"WhatNext"} == DONTCONT) {
      print $handle "Behaviour after match:\t\t", "don't continue\n";
    } else {
      print $handle "Behaviour after match:\t\t", "take next\n";
    }

    print $handle "Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType"},
                  $config->{"PatLines"}, $config->{"Pattern"});
    print $handle "\n";

    print $handle "Context:\t\t\t";
    print $handle context2str($ref->{"Context"});
    print $handle "\n";

    print $handle "Event:\t\t\t\t", $ref->{"Desc"}, "\n";

    print $handle "Action:\t\t\t\t";
    print $handle actionlist2str($ref->{"Action"});
    print $handle "\n";

    print $handle "Window:\t\t\t\t", $ref->{"Window"}, " seconds\n";

    print $handle "Threshold:\t\t\t", $ref->{"Threshold"}, "\n";

    print $handle scalar(@{$ref->{"Times"}}), " events observed at:\n";

    foreach $time (@{$ref->{"Times"}}) 
        { print $handle scalar(localtime($time)), "\n"; }

    print $handle "\n";

  }

  elsif ($ref->{"Type"} == SINGLE_W_2_THRESHOLDS) {

    print $handle "Type:\t\t\t\t";
    print $handle "SingleWith2Thresholds\n";

    if ($config->{"WhatNext"} == DONTCONT) {
      print $handle "Behaviour after match:\t\t", "don't continue\n";
    } else {
      print $handle "Behaviour after match:\t\t", "take next\n";
    }

    print $handle "Pattern:\t\t\t";
    print $handle pattern2str($config->{"PatType"},
                  $config->{"PatLines"}, $config->{"Pattern"});
    print $handle "\n";

    print $handle "Context:\t\t\t";
    print $handle context2str($ref->{"Context"});
    print $handle "\n";

    print $handle "1st Event:\t\t\t", $ref->{"Desc"}, "\n";

    print $handle "1st Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action"});
    print $handle "\n";

    print $handle "1st Window:\t\t\t", $ref->{"Window"}, " seconds\n";

    print $handle "1st Threshold:\t\t\t", $ref->{"Threshold"}, "\n";

    print $handle "2nd Event:\t\t\t", $ref->{"Desc2"}, "\n";

    print $handle "2nd Action:\t\t\t";
    print $handle actionlist2str($ref->{"Action2"});
    print $handle "\n";

    print $handle "2nd Window:\t\t\t", $ref->{"Window2"}, " seconds\n";

    print $handle "2nd Threshold:\t\t\t", $ref->{"Threshold2"}, "\n";

    print $handle scalar(@{$ref->{"Times"}}), " events observed at ";

    if ($ref->{"2ndPass"}) { 
      print $handle "(checking 2nd threshold):\n"; 
    } else { 
      print $handle "(checking 1st threshold):\n"; 
    }

    foreach $time (@{$ref->{"Times"}})
        { print $handle scalar(localtime($time)), "\n"; }

    print $handle "\n";

  }

}



# Parameters: -
# Action: save some information about the current state of the program
#         to dump file.

sub dump_data {

  my($i, $line, $key, $ref, $file, $event);
  my($time, $user, $system, $cuser, $csystem);
  my($name, %reported_names);

  if (-l $dumpfile) {

    if ($debuglevel >= LOG_ERR) {
      log_msg(LOG_ERR, "Can't write to dumpfile: $dumpfile is a symbolic link");
    }

    return;

  }

  if (!open(DUMPFILE, ">$dumpfile")) {

    if ($debuglevel >= LOG_ERR) {
      log_msg(LOG_ERR, "Can't open dumpfile $dumpfile ($!)");
    }

    return;

  }

  # print date and version

  $time = time();

  print DUMPFILE "Time of the dump: ", scalar(localtime($time)), "\n";
  print DUMPFILE "Time of the last configuration load: ", 
                 scalar(localtime($lastconfigload)), "\n";
  print DUMPFILE "Program version: ", $SEC_VERSION, "\n";

  print DUMPFILE "\n";


  # print performance statistics

  print DUMPFILE "Performance statistics:\n";
  print DUMPFILE '=' x 60, "\n";

  ($user, $system, $cuser, $csystem) = times();

  print DUMPFILE "Run time: ", $time - $startuptime, " seconds\n";
  print DUMPFILE "User time: $user seconds\n";
  print DUMPFILE "System time: $system seconds\n";
  print DUMPFILE "Child user time: $cuser seconds\n";
  print DUMPFILE "Child system time: $csystem seconds\n";
  print DUMPFILE "Processed input lines: $processedlines\n";

  print DUMPFILE "\n";


  # print rule usage statistics

  print DUMPFILE "Rule usage statistics:\n";
  print DUMPFILE '=' x 60, "\n";

  foreach $file (@conffiles) {

    print DUMPFILE "\nStatistics for the rules from $file\n";
    print DUMPFILE '-' x 60, "\n";
    $i = 1;

    foreach $ref (@{$configuration{$file}}) {

      print DUMPFILE "Rule $i at line ", $ref->{"LineNo"}, 
        " (", $ref->{"Desc"}, ") has matched ", 
          $ref->{"MatchCount"}, " events\n";

      ++$i;

    }

  }

  print DUMPFILE "\n";


  # print input sources

  print DUMPFILE "Input sources:\n";
  print DUMPFILE '=' x 60, "\n";

  foreach $file (@inputfiles) {

    print DUMPFILE $file, " ";

    if ($inputsrc{$file}->{"open"}) { 
      print DUMPFILE "(status: Open, "; 
    } else { 
      print DUMPFILE "(status: Closed, "; 
    }

    print DUMPFILE "received data: ", 
      $inputsrc{$file}->{"lines"}, " lines, ";

    if ($intcontexts) {
      print DUMPFILE "context: ", $inputsrc{$file}->{"context"};
    } else {
      print DUMPFILE "no context set";
    }

    print DUMPFILE ")\n";

  }

  print DUMPFILE "\n";


  # print content of input buffer

  print DUMPFILE "Content of input buffer:\n";
  print DUMPFILE '-' x 60, "\n";

  for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {

    print DUMPFILE $input_buffer[$i % $bufsize], "\n";

  }

  print DUMPFILE '-' x 60, "\n";
  print DUMPFILE "\n";


  # print content of pending event buffer

  $i = 0;
  print DUMPFILE "Pending events:\n";
  print DUMPFILE '=' x 60, "\n";

  foreach $ref (@pending_events) { 

    print DUMPFILE "Event: ", $ref->[1], "\n";
    print DUMPFILE "Will be created at: ", 
                   scalar(localtime($ref->[0])), "\n";

    print DUMPFILE "\n";
    ++$i;

  }

  print DUMPFILE "Total: $i elements\n\n";


  # print the list of active event correlation operations

  $i = 0;
  print DUMPFILE "List of event correlation operations:\n";
  print DUMPFILE '=' x 60, "\n";

  while (($key, $ref) = each(%corr_list)) { 

    print_element(*DUMPFILE, $key, $ref);
    print DUMPFILE '-' x 60, "\n";

    ++$i; 

  }

  print DUMPFILE "Total: $i elements\n\n";


  # print the list of active contexts

  $i = 0;
  %reported_names = ();

  print DUMPFILE "List of contexts:\n";
  print DUMPFILE '=' x 60, "\n";

  while (($key, $ref) = each(%context_list)) { 

    if (exists($reported_names{$key}))  { next; }

    foreach $name (@{$ref->{"Aliases"}}) {

      print DUMPFILE "Context Name: ", $name, "\n";
      $reported_names{$name} = 1;

    }

    print DUMPFILE "Creation Time: ", 
                   scalar(localtime($ref->{"Time"})), "\n";

    if ($ref->{"Window"}) {
      print DUMPFILE "Lifetime: ", $ref->{"Window"}, " seconds\n";
    } else {
      print DUMPFILE "Lifetime: infinite\n";
    }

    if (scalar(@{$ref->{"Action"}})) {
      print DUMPFILE "Action on delete: ", 
                     actionlist2str($ref->{"Action"});
      print DUMPFILE " (%s = ", $ref->{"Desc"}, ")\n";
    }

    if (scalar(@{$ref->{"Buffer"}})) {

      print DUMPFILE scalar(@{$ref->{"Buffer"}}), 
                     " events associated with context:\n";

      foreach $event (@{$ref->{"Buffer"}}) 
              { print DUMPFILE $event, "\n"; }

    }

    print DUMPFILE '-' x 60, "\n";
    ++$i;

  }
    
  print DUMPFILE "Total: $i elements\n\n";


  # print the list of running children

  $i = 0;
  print DUMPFILE "Child processes:\n";
  print DUMPFILE '=' x 60, "\n";

  while (($key, $ref) = each(%children)) { 

    print DUMPFILE "Child PID: ", $key, "\n";
    print DUMPFILE "Commandline started by child: ", $ref->{"cmd"}, "\n"; 

    print DUMPFILE '-' x 60, "\n";
    ++$i;

  }
    
  print DUMPFILE "Total: $i elements\n\n";


  # print the values of user-defined variables

  $i = 0;
  print DUMPFILE "User-defined variables:\n";
  print DUMPFILE '=' x 60, "\n";

  foreach $key (sort(keys %variables)) {

    if (defined($variables{$key})) {
      print DUMPFILE "%$key = '", $variables{$key}, "'\n";
    } else {
      print DUMPFILE "%$key = undef\n";
    }

    ++$i;

  }
    
  print DUMPFILE "Total: $i elements\n\n";


  close(DUMPFILE);

}



#################################################################
# Functions related to timing, input handling and signal handling
#################################################################


# Parameters: par1 - text of the SEC internal event
# Action: insert the SEC internal event par1 into the event buffer
#         and match it against the rulebase.

sub internal_event {

  my($text) = $_[0];
  my($context, $conffile);


  $context = "SEC_INTERNAL_EVENT";

  if ($debuglevel >= LOG_INFO) {
    log_msg(LOG_INFO, "Creating SEC internal context '$context'");
  }

  $context_list{$context} = { "Time" => time(), 
                              "Window" => 0, 
                              "Buffer" => [],
                              "Action" => [],
                              "Desc" => "SEC internal",
                              "Aliases" => [ $context ] };

  if ($debuglevel >= LOG_INFO) {
    log_msg(LOG_INFO, "Creating SEC internal event '$text'");
  }

  $bufpos = ($bufpos + 1) % $bufsize;
  $input_buffer[$bufpos] = $text;

  foreach $conffile (@conffiles)  { process_rules($conffile); }

  ++$processedlines;

  if ($debuglevel >= LOG_INFO) {
    log_msg(LOG_INFO, "Deleting SEC internal context '$context'");
  }

  delete $context_list{$context};

}



# Parameters: par1 - process ID
# Action: read available data from process par1 and create events.

sub consume_pipe {

  my($pid) = $_[0];
  my($rin, $ret, $pos, $nbytes, $event);


  for (;;) {

    # poll the pipe with select()

    $rin = '';
    vec($rin, fileno($children{$pid}->{"fh"}), 1) = 1;
    $ret = select($rin, undef, undef, 0);

    # if select() failed because of the caught signal, try again,
    # otherwise close the pipe and quit the read-loop;
    # if select() returned 0, no data is available, so quit the read-loop

    if (!defined($ret)  ||  $ret < 0) {

      if ($! == EINTR)  { next; }

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, 
                "Process $pid pipe select error ($!), closing the pipe"); 
      }

      close($children{$pid}->{"fh"});
      $children{$pid}->{"open"} = 0;
      last; 

    } elsif ($ret == 0)  { last; }

    # try to read from the pipe

    $nbytes = sysread($children{$pid}->{"fh"}, 
                      $children{$pid}->{"buffer"},
                      $blocksize, length($children{$pid}->{"buffer"}));

    # if sysread() failed and the reason was other than a caught signal,
    # close the pipe and quit the read-loop;
    # if sysread() failed because of a caught signal, continue (posix
    # allows read(2) to be interrupted by a signal and return -1, with
    # some bytes already been read into read buffer);
    # if sysread() returned 0, the other end has closed the pipe, so close
    # our end of the pipe and quit the read-loop

    if (!defined($nbytes)) { 

      if ($! != EINTR) { 

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Process $pid pipe IO error ($!), closing the pipe"); 
        }

        close($children{$pid}->{"fh"});
        $children{$pid}->{"open"} = 0;
        last;

      }

    } elsif ($nbytes == 0) { 

      close($children{$pid}->{"fh"});
      $children{$pid}->{"open"} = 0;
      last; 

    }

    # create all lines of pipe buffer as events, except the last one
    # which could be a partial line with its 2nd part still not written

    for (;;) {

      $pos = index($children{$pid}->{"buffer"}, "\n");

      if ($pos == -1)  { last; }

      $event = substr($children{$pid}->{"buffer"}, 0, $pos);
      substr($children{$pid}->{"buffer"}, 0, $pos + 1) = "";

      if ($debuglevel >= LOG_DEBUG) {
        log_msg(LOG_DEBUG, 
                "Creating event '$event' (received from child $pid)");
      }

      push @events, $event;

    }

  }

  # if the child pipe has been closed but the pipe buffer still contains
  # data (bytes with no terminating newline), create an event from this data

  if (!$children{$pid}->{"open"}  &&  length($children{$pid}->{"buffer"})) {

    $event = $children{$pid}->{"buffer"};

    if ($debuglevel >= LOG_DEBUG) {
      log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)");
    }

    push @events, $event;

  }

}



# Parameters: -
# Action: check the status of SEC child processes and process their output

sub check_children {

  my($pid, $exitcode);


  # if the child was started by 'spawn' action, gather the child
  # standard output and create events (if child has more than PIPE_BUF
  # bytes to write, we must start reading from pipe before child 
  # termination, otherwise child would block)

  while ($pid = each(%children)) { 

    if ($children{$pid}->{"open"})  { consume_pipe($pid); }

  }

  # get the exit status of every terminated child process.

  for (;;) {

    # get the exit status of next terminated child process and
    # quit the loop if there are no more deceased children
    # waitpid will return -1 if there are no deceased children (or no
    # children at all) at the moment; on some platforms, 0 means that 
    # there are children, but none of them is deceased at the moment.
    # Process ID can be a positive (UNIX) or negative (windows) integer.

    $pid = waitpid(-1, &WNOHANG);
    if ($pid == -1 || $pid == 0) { last; }

    # check if the child process has really exited (and not just stopped).
    # This check will be skipped on Windows which does not have a valid
    # implementation of WIFEXITED macro.

    if ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?)) {

      # find the child exit code

      $exitcode = $? >> 8;

      # if the terminated child was started as a part of 'spawn'
      # action and its pipe has not been emptied yet, do it now

      if ($children{$pid}->{"open"})  { consume_pipe($pid); }

      # if the child exit code is zero and the child was started as 
      # a part of SINGLE_W_SCRIPT rule, execute action list 'Action'

      if (!$exitcode  &&  defined($children{$pid}->{"Desc"})) {

        if ($debuglevel >= LOG_DEBUG) {
          log_msg(LOG_DEBUG, "Child $pid terminated with exitcode 0");
        }

        execute_actionlist($children{$pid}->{"Action"},
                           $children{$pid}->{"Desc"});

      # if the child exit code is non-zero and the child was started as 
      # a part of SINGLE_W_SCRIPT rule, execute action list 'Action2'

      } elsif ($exitcode  &&  defined($children{$pid}->{"Desc"})) {

        if ($debuglevel >= LOG_DEBUG) {
          log_msg(LOG_DEBUG,
                  "Child $pid terminated with non-zero exitcode $exitcode");
        }

        execute_actionlist($children{$pid}->{"Action2"},
                           $children{$pid}->{"Desc"});

      # if the child exit code is non-zero, log a message

      } elsif ($exitcode) {

        if ($debuglevel >= LOG_WARN) {
          log_msg(LOG_WARN,
                  "Child $pid terminated with non-zero exitcode $exitcode (",
                  $children{$pid}->{"cmd"}, ")");
        }

      }

      delete $children{$pid};

    }

  }

}



# Parameters: -
# Action: check whether signals have arrived and process them

sub check_signals {

  my($file);

  # if SIGHUP has arrived, reopen input files and logfile, re-read 
  # configuration and empty all lists concerning events and correlation 
  # information; if SIGABRT has arrived, behave like SIGHUP but preserve 
  # contexts that are active

  if ($refresh || $softrefresh) {

    if ($refresh  &&  $debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE,
              "SIGHUP received: reopening input and logfile, cleaning all internal data structures, terminating children and reading configuration");
    }

    elsif ($softrefresh  &&  $debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE,
              "SIGABRT received: reopening input and logfile, reading configuration and cleaning all internal data structures (except contexts and variables)");
    }

    %corr_list = ();

    if ($refresh) { 

      child_cleanup();
      %context_list = (); 
      %variables = ();

    }

    @pending_events = ();

    foreach $file (@inputfiles) {
      if ($inputsrc{$file}->{"open"})  { close($inputsrc{$file}->{"fh"}); }
    }

    open_input(-1);

    read_config();

    # if -intevents flag was specified and SEC received SIGHUP (SIGABRT),
    # generate the SEC_RESTART (SEC_SOFTRESTART) event

    if ($intevents) {

      if ($refresh)  { internal_event("SEC_RESTART"); }
      elsif ($softrefresh)  { internal_event("SEC_SOFTRESTART"); }

    }

    # reopen the logfile and write lines from temporary buffer to the logfile

    if (defined($logfile)) {

      close(LOGFILE);
      open_logfile($logfile);
      write_logmsgbuffer();

    }

    # reopen connection to the system logger

    if (defined($syslogf)) {

      Sys::Syslog::closelog();
      open_syslog($syslogf);

    }

    # set flags back to zero

    $refresh = 0;
    $softrefresh = 0;

  }

  # if SIGUSR1 has arrived, create dump file

  if ($dumpdata) {

    if ($debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE, "SIGUSR1 received: dumping data to $dumpfile");
    }

    dump_data();

    $dumpdata = 0;

  }

  # if SIGUSR2 has arrived, reopen logfile

  if ($openlog) {

    if ($debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE, "SIGUSR2 received: reopening logfile");
    }

    # reopen the logfile, write the content of temporary buffer to logfile,
    # reopen connection to the system logger, and set flags back to zero

    if (defined($logfile)) {

      close(LOGFILE);
      open_logfile($logfile);
      write_logmsgbuffer();

    }
 
    if (defined($syslogf)) {

      Sys::Syslog::closelog();
      open_syslog($syslogf);

    }

    $openlog = 0;

  }

  # if SIGTERM has arrived, shutdown SEC

  if ($terminate) {

    if ($debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE, "Received SIGTERM, exiting!");
    }

    # If -intevents flag was specified, generate the SEC_SHUTDOWN event.
    # Note that the $terminate flag will temporarily be set to zero, as if
    # SEC_SHUTDOWN event was generated before SIGTERM under normal circum-
    # stances (when $terminate is set, SEC does not fork any new processes). 
    # Note also, that after generating SEC_SHUTDOWN event, SEC will sleep for 
    # TERMTIMEOUT seconds, so that child processes that were triggered by 
    # SEC_SHUTDOWN have time to create a signal handler for SIGTERM if needed.

    if ($intevents) { 

      $terminate = 0;
      internal_event("SEC_SHUTDOWN"); 
      $terminate = 1;
      sleep(TERMTIMEOUT);

    }

    # final shutdown procedures

    child_cleanup();
    exit(0);

  }

}



# Parameters: par1 - name of the input file
#             par2 - file position
# Action: Input file will be opened and file position will be moved to 
#         position par2 (-1 means "seek EOF" and 0 means "don't seek at all").
#         Return the filehandle of the input file, or 'undef' if open failed.

sub open_input_file {

  my($file) = $_[0];
  my($fpos) = $_[1];
  my($flags);
  local *INPUT;   # we need to use 'local *', since each time we enter
                  # this procedure a new filehandle must be created, that
                  # will be returned from this procedure for external use

  # if input is stdin, duplicate it

  if ($file eq "-") {

    if ($WIN32) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Stdin is not supported as input on Win32");
      }

      return undef;

    }

    while (!open(INPUT, "<&STDIN")) {

      if ($! == EINTR)  { next; }

      if ($debuglevel >= LOG_ERR) { 
        log_msg(LOG_ERR, "Can't dup stdin ($!)"); 
      }

      return undef;

    }

  }

  # if input file is a regular file, open it for reading

  elsif (-f $file) {

    while (!sysopen(INPUT, $file, O_RDONLY)) {

      if ($! == EINTR)  { next; }

      if ($debuglevel >= LOG_ERR) { 
        log_msg(LOG_ERR, "Can't open file $file ($!)"); 
      }

      return undef;

    }

  }

  # if input is a named pipe, open it both for reading and writing
  # (the open would block if there are no writers at the moment,
  # so process pretends to be a writer)

  elsif (-p $file) {

    if ($WIN32) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Named pipe is not supported as input on Win32");
      }

      return undef;

    }

    while (!sysopen(INPUT, $file, O_RDWR)) {

      if ($! == EINTR)  { next; }

      if ($debuglevel >= LOG_ERR) { 
        log_msg(LOG_ERR, "Can't open file $file ($!)"); 
      }

      return undef;

    }

  }

  # unsupported or non-existing input file

  else {

    if ($debuglevel >= LOG_ERR) {
      log_msg(LOG_ERR,
              "Input file $file is not stdin, regular file, or named pipe!");
    }

    return undef;

  }

  # if INPUT filehandle is connected to a regular file
  # and $fpos == -1 or $fpos > 0, seek the given position in the file

  if (-f INPUT) {

    if ($fpos == -1) {

      while (!sysseek(INPUT, 0, SEEK_END)) {

        if ($! == EINTR)  { next; }

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Can't seek EOF in file $file ($!)");
        }

        close(INPUT);
        return undef;

      }

    }

    elsif ($fpos > 0) {

      while (!sysseek(INPUT, $fpos, SEEK_SET)) {

        if ($! == EINTR)  { next; }

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Can't seek position $fpos in file $file ($!)");
        }

        close(INPUT);
        return undef;

      }

    }

  }

  return *INPUT;

}



# Parameters: par1 - file position
# Action: evaluate the inputfile patterns given in commandline, form the 
#         list of inputfiles and save it to global array @inputfiles. Each
#         input file will then be opened and file position will be moved to
#         position par1 (-1 means "seek EOF" and 0 means "don't seek at all").
#         If -intcontexts option is active, also set up internal contexts.

sub open_input {

  my($fpos) = $_[0];
  my($filepat, $pattern, $context);
  my($inputfile, @files, $time, $fh);


  # Initialize (or clean) global arrays %inputsrc and @inputfiles
  # (the keys for %inputsrc are members of global array @inputfiles)
 
  %inputsrc = ();
  @inputfiles = ();

  # Initialize (or clean) the read buffer

  @readbuffer = ();

  # Form the list of configuration files, save it to global array
  # @inputfiles, and open the files

  $time = time();

  foreach $filepat (@inputfilepat) { 

    # check if the input file pattern has a context associated with it,
    # and if it does, force the -intcontexts option

    if ($filepat =~ /^(.+)=(\S+)$/) {

      $pattern = $1;
      $context = $2;
      $intcontexts = 1;

    } else { 

      $pattern = $filepat;
      $context = undef; 

    }

    # interpret the pattern, and open the files that correspond to a pattern

    @files = glob($pattern);

    foreach $inputfile (@files) {

      $fh = open_input_file($inputfile, $fpos);

      if (!defined($context))  { $context = "_FILE_EVENT_$inputfile"; }

      $inputsrc{$inputfile} = { "fh" => $fh,
                                "open" => defined($fh),
                                "buffer" => "",
                                "scriptexec" => 0,
                                "checktime" => 0,
                                "lastreopen" => $time,
                                "lastread" => $time,
                                "lines" => 0,
                                "context" => $context };

    }

    push @inputfiles, @files;

  }

  # if -intcontexts option is active, set up internal contexts

  if ($intcontexts) {

    %int_contexts = ();

    foreach $inputfile (@inputfiles) {

      $context = $inputsrc{$inputfile}->{"context"};

      if (exists($int_contexts{$context}))  { next; }

      $int_contexts{$context} = { "Time" => $time,
                                  "Window" => 0,
                                  "Buffer" => [],
                                  "Action" => [],
                                  "Desc" => "SEC internal",
                                  "Aliases" => [ $context ] };

    }

    $context = "_INTERNAL_EVENT";

    $int_contexts{$context} = { "Time" => $time,
                                "Window" => 0,
                                "Buffer" => [],
                                "Action" => [],
                                "Desc" => "SEC internal",
                                "Aliases" => [ $context ] };

  }

}



# Parameters: par1 - name of the input file
# Action: check if input file has been removed, recreated or truncated.
#         Return 1 if input file has changed and should be reopened; 
#         return 0 if the file has not changed or should not be
#         reopened right now. If system calls of this procedure
#         are interrupted by a signal, return 0 also. If system call
#         on the input file fails, close the file and return undef.

sub input_shuffled {

  my($file) = $_[0];
  my(@oldstat, @newstat, $fpos);


  # standard input is always intact (it can't be recreated or truncated)

  if ($file eq "-")  { return 0; }

  # stat the input filehandle and exit if stat fails

  @oldstat = stat($inputsrc{$file}->{"fh"});

  if (!scalar(@oldstat)) { 

    if ($! == EINTR)  { return 0; }

    if ($debuglevel >= LOG_ERR) {
      log_msg(LOG_ERR, 
        "Can't stat filehandle of input file $file ($!), closing the file");
    }

    close($inputsrc{$file}->{"fh"});
    $inputsrc{$file}->{"open"} = 0;

    return undef;

  }

  # stat the input file and return 0 if stat fails (e.g., input file has 
  # been removed and not recreated yet, so we can't reopen it now)

  @newstat = stat($file);

  if (!scalar(@newstat))  { return 0; }

  # check if i-node numbers of filehandle and input file are different
  # (this check will be skipped on Windows).

  if ( !$WIN32 && 
       ($oldstat[0] != $newstat[0] || $oldstat[1] != $newstat[1]) ) { 

    if ($debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE, "Input file $file has been recreated");
    }

    return 1; 

  }

  # Check if file size has decreased

  if (-f $inputsrc{$file}->{"fh"}) {

    $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);

    if (!defined($fpos)) {

      if ($! == EINTR)  { return 0; }

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, 
          "Can't seek filehandle of input file $file ($!), closing the file");
      }

      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;

      return undef;

    }

    if ($fpos > $newstat[7]) { 

      if ($debuglevel >= LOG_NOTICE) {
        log_msg(LOG_NOTICE, "Input file $file has been truncated");
      }

      return 1; 

    }

  }

  return 0;

}



# Parameters: par1 - name of the input file
# Action: read next line from the input file and return it (without '\n' at 
#         the end of the line). If the file has no complete line available, 
#         undef is returned. If read system call fails, or returns EOF and 
#         -notail mode is active, the file is closed and undef is returned.

sub read_line_from_file {

  my($file) = $_[0];
  my($pos, $line, $rin, $ret, $nbytes);


  # if there is a complete line in the read buffer of the file (i.e., the 
  # read buffer contains at least one newline symbol), read line from there

  $pos = index($inputsrc{$file}->{"buffer"}, "\n");

  if ($pos != -1) {

    $line = substr($inputsrc{$file}->{"buffer"}, 0, $pos);
    substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = "";
    return $line;

  }

  if (-f $inputsrc{$file}->{"fh"}) {

    # try to read data from a regular file

    $nbytes = sysread($inputsrc{$file}->{"fh"}, 
                      $inputsrc{$file}->{"buffer"},
                      $blocksize, length($inputsrc{$file}->{"buffer"}));

    # check the exit value from sysread() that was saved to $nbytes:
    # if $nbytes == undef, sysread() failed;
    # if $nbytes == 0, we have reached EOF (no more data available);
    # otherwise ($nbytes > 0) sysread() succeeded

    if (!defined($nbytes)) { 

      # check if sysread() failed because of the caught signal (posix
      # allows read(2) to be interrupted by a signal and return -1, with
      # some bytes already been read into read buffer); if sysread() failed
      # because of some other reason, close the file and return undef

      if ($! != EINTR) { 

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file");
        }

        close($inputsrc{$file}->{"fh"});
        $inputsrc{$file}->{"open"} = 0;

        return undef;

      } 

    } elsif ($nbytes == 0) { 

      # if we have reached EOF and -tail mode is set, return undef; if 
      # -notail mode is active, close the file, and if the file buffer is not 
      # empty, return its content (bytes between the last newline in the file 
      # and EOF), otherwise return undef

      if ($tail)  { return undef; }

      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;

      $line = $inputsrc{$file}->{"buffer"};
      $inputsrc{$file}->{"buffer"} = "";

      if (length($line))  { return $line; }  else { return undef; }
      
    }

  } else {

    # poll the input pipe for new data with select()

    $rin = '';
    vec($rin, fileno($inputsrc{$file}->{"fh"}), 1) = 1;
    $ret = select($rin, undef, undef, 0);

    if (!defined($ret)  ||  $ret < 0) {

      # if select() failed because of the caught signal, return undef,
      # otherwise close the file and return undef

      if ($! == EINTR)  { return undef; }

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, 
                "Input file $file select error ($!), closing the file");
      }

      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;

      return undef;

    } elsif ($ret == 0) {

      # if we have reached EOF and -tail mode is set, return undef; if 
      # -notail mode is active, close the file, and if the file buffer is not 
      # empty, return its content (bytes between the last newline in the file 
      # and EOF), otherwise return undef

      if ($tail)  { return undef; }

      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;

      $line = $inputsrc{$file}->{"buffer"};
      $inputsrc{$file}->{"buffer"} = "";

      if (length($line))  { return $line; }  else { return undef; }

    }

    # try to read from the pipe

    $nbytes = sysread($inputsrc{$file}->{"fh"}, 
                      $inputsrc{$file}->{"buffer"}, 
                      $blocksize, length($inputsrc{$file}->{"buffer"}));

    # check the exit value from sysread() that was saved to $nbytes:
    # if $nbytes == undef, sysread() failed;
    # if $nbytes == 0, we have reached EOF (no more data available);
    # otherwise ($nbytes > 0) sysread() succeeded

    if (!defined($nbytes)) { 

      # check if sysread() failed because of the caught signal (posix
      # allows read(2) to be interrupted by a signal and return -1, with
      # some bytes already been read into read buffer); if sysread() failed
      # because of some other reason, log an error message and return undef

      if ($! != EINTR) { 

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file");
        }

        close($inputsrc{$file}->{"fh"});
        $inputsrc{$file}->{"open"} = 0;

        return undef;

      } 

    } elsif ($nbytes == 0) { 

      # if sysread() returns 0, that signals that there are no writers
      # on the pipe anymore, and from now on select() always claims that 
      # there is some data (EOF) to be read (with named pipe we should 
      # never reach that condition, since we have opened it in RW-mode)

      if ($debuglevel >= LOG_ERR) { 
        log_msg(LOG_ERR, 
          "Input file $file IO error (unknown pipe error), closing the file"); 
      }

      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;

      return undef;

    }

  }

  # if the read buffer contains a newline, cut the first line from the 
  # read buffer and return it, otherwise return undef (even if there are 
  # some bytes in the buffer)

  $pos = index($inputsrc{$file}->{"buffer"}, "\n");

  if ($pos != -1) {

    $line = substr($inputsrc{$file}->{"buffer"}, 0, $pos);
    substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = "";
    return $line;

  }

  return undef;

}



# Parameters: par1 - variable where the input line is saved
#             par2 - variable where the input file name is saved
# Action: attempt to read next line from each input file, and store the
#         received lines with corresponding input file names to the read 
#         buffer. Return the first line from the read buffer, with par1 set 
#         to line and par2 set to file name. If there were no new lines in 
#         input files, par1 is set to undef but par2 reflects the status of 
#         input files: value 1 means that at least one of the input files has 
#         new data available (although no complete line), value 0 means that 
#         no data were added to any of the input files since the last poll.

sub read_line {

  my($line, $file); 
  my($time, $shuffled);
  my($len, $newdata);

  # check all input files and store new data to the read buffer

  $newdata = 0;

  if (defined($input_timeout) || defined($reopen_timeout) || 
      defined($check_timeout)) { $time = time(); }

  foreach $file (@inputfiles) {

    # if the check timer for the file has not expired yet, skip the file

    if (defined($check_timeout) && $time < $inputsrc{$file}->{"checktime"}) { 
      next; 
    }

    # before reading, memorize the number of bytes in the read cache

    $len = length($inputsrc{$file}->{"buffer"});

    # if the input file is open, read a line from it; if the input file
    # is closed, treat it as an open file with no new data available

    if ($inputsrc{$file}->{"open"}) { 
      $line = read_line_from_file($file);
    } else { 
      $line = undef;
    }

    if (defined($line)) {

      # if we received a new line, write the line to the read buffer; also 
      # update time-related variables and call external script, if necessary

      push @readbuffer, $line;
      push @readbuffer, $file;

      if (defined($input_timeout)) {
        $inputsrc{$file}->{"lastread"} = $time;
      }

      if (defined($reopen_timeout)) {
        $inputsrc{$file}->{"lastreopen"} = $time;
      }

      if ($inputsrc{$file}->{"scriptexec"}) {

        if ($debuglevel >= LOG_INFO) {
          log_msg(LOG_INFO,
                  "Input received, executing script $timeout_script 0 $file");
        }

        shell_cmd("$timeout_script 0 $file");
        $inputsrc{$file}->{"scriptexec"} = 0;

      }

    } 

    else {

      # if we were unable to obtain a complete line from the file but
      # new bytes were stored to the read cache, don't set the check
      # timer and skip shuffle and timeout checks

      if ($len < length($inputsrc{$file}->{"buffer"})) { 
        $newdata = 1; next; 
      }

      # if there were no new bytes in the file and -notail mode is active, 
      # don't set the check timer and skip shuffle and timeout checks (i.e., 
      # -input_timeout, -timeout_script, -reopen_timeout, and -check_timeout 
      # options are ignored when -notail is set)

      if (!$tail)  { next; }

      # set the timer to ignore the file for the next $check_timeout seconds

      if (defined($check_timeout)) {
        $inputsrc{$file}->{"checktime"} = $time + $check_timeout;
      }

      # if there were no new bytes in the file and it has been shuffled,
      # reopen the file and start to process it from the beginning

      if ($inputsrc{$file}->{"open"}) {

        $shuffled = input_shuffled($file);

        if (defined($shuffled)  &&  $shuffled) {

          if ($debuglevel >= LOG_NOTICE) {
            log_msg(LOG_NOTICE,
                    "Shuffled $file, reopening and processing from the start");
          }

          close($inputsrc{$file}->{"fh"});

          $inputsrc{$file}->{"fh"} = open_input_file($file, 0);
          $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});

          if (defined($reopen_timeout)) {
            $inputsrc{$file}->{"lastreopen"} = $time;
          }

        }

      }

      # if we have waited for new bytes for more than $input_timeout
      # seconds, execute external script $timeout_script with commandline
      # parameters "1 <filename>"

      if (defined($input_timeout)  &&
          $time - $inputsrc{$file}->{"lastread"} >= $input_timeout  &&  
          !$inputsrc{$file}->{"scriptexec"}) {

        if ($debuglevel >= LOG_INFO) {
          log_msg(LOG_INFO,
                  "No input, executing script $timeout_script 1 $file");
        }

        shell_cmd("$timeout_script 1 $file");
        $inputsrc{$file}->{"scriptexec"} = 1;

      }

      # if we have waited for new bytes for more than $reopen_timeout
      # seconds, reopen the input file

      if (defined($reopen_timeout)  &&
          $time - $inputsrc{$file}->{"lastreopen"} >= $reopen_timeout) {

        if ($debuglevel >= LOG_DEBUG) {
          log_msg(LOG_DEBUG,
                  "Timeout reached when reading from $file, reopening");
        }

        if ($inputsrc{$file}->{"open"})  { close($inputsrc{$file}->{"fh"}); }

        $inputsrc{$file}->{"fh"} = open_input_file($file, -1);
        $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});

        $inputsrc{$file}->{"lastreopen"} = $time;

      }

    }

  }
  
  # if we succeeded to read new data and write it to the read buffer, 
  # return the first line from the buffer; otherwise return undef

  if (scalar(@readbuffer)) {

    $_[0] = shift @readbuffer;
    $_[1] = shift @readbuffer;

  } else {

    $_[0] = undef;
    $_[1] = $newdata;

  }

}



# Parameters: -
# Action: daemonize the process

sub daemonize {

  my($pid);

  # -detach is not supported on Windows

  if ($WIN32) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT, "'-detach' option is not supported on Win32");
    }

    exit(1);

  }

  # if stdin was specified as input, we can't become a daemon

  if (grep {$_ eq "-"} @inputfiles) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT,
              "Can't become a daemon (stdin is specified as input), exiting!");
    }

    exit(1);

  }

  # fork a new copy of the process and exit from the parent

  $pid = fork();

  if (!defined($pid)) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT,
              "Can't fork a new process for daemonization ($!), exiting!");
    }

    exit(1);

  }

  if ($pid)  { exit(0); }

  # create a new process group

  if (!POSIX::setsid()) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT, "Can't start a new session ($!), exiting!");
    }

    exit(1);

  }

  # connect stdin, stdout, and stderr to /dev/null

  if (!open(STDIN, '/dev/null')) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT, "Can't connect stdin to /dev/null ($!), exiting!");
    }

    exit(1);

  }

  if (!open(STDOUT, '>/dev/null')) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT, "Can't connect stdout to /dev/null ($!), exiting!");
    }

    exit(1);

  }

  if (!open(STDERR, '>&STDOUT')) {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT, 
              "Can't connect stderr to stdout with dup ($!), exiting!");
    }

    exit(1);

  }

  if ($debuglevel >= LOG_DEBUG) {
    log_msg(LOG_DEBUG, "Daemonization complete");
  }

}



# Parameters: -
# Action: terminate child processes

sub child_cleanup {

  my($pid);

  while($pid = each(%children)) { 

    if ($debuglevel >= LOG_NOTICE) {
      log_msg(LOG_NOTICE, "Sending SIGTERM to process $pid");
    }

    kill('TERM', $pid); 

  }

}



# Parameters: -
# Action: on arrival of SIGHUP set flag $refresh

sub hup_handler {

  $SIG{HUP} = \&hup_handler;
  $refresh = 1;

}               



# Parameters: -
# Action: on arrival of SIGABRT set flag $softrefresh

sub abrt_handler {

  $SIG{ABRT} = \&abrt_handler;
  $softrefresh = 1;

}               



# Parameters: -
# Action: on arrival of SIGUSR1 set flag $dumpdata

sub usr1_handler {

  $SIG{USR1} = \&usr1_handler;
  $dumpdata = 1;

}               



# Parameters: -
# Action: on arrival of SIGUSR2 set flag $openlog

sub usr2_handler {

  $SIG{USR2} = \&usr2_handler;
  $openlog = 1;

}               



# Parameters: -
# Action: on arrival of SIGTERM clean things up and exit

sub term_handler {

  $SIG{TERM} = \&term_handler;
  $terminate = 1;

}               



##################################################################
# ------------------------- MAIN PROGRAM -------------------------
##################################################################

### Open logfile

if (defined($logfile))  { open_logfile($logfile); }
if (defined($syslogf))  { open_syslog($syslogf); }

log_msg(LOG_NOTICE, "Simple Event Correlator version $SEC_VERSION");


# If -detach flag was specified, chdir to / for not disturbing future 
# unmount of current filesystem. Must be done before read_config() to 
# receive error messages about scripts that would not be found at runtime

if ($detach) { 

  if ($debuglevel >= LOG_NOTICE) {
    log_msg(LOG_NOTICE, "Changing working directory to /");
  }

  chdir('/'); 

}


### Read in configuration

my $config_ok = read_config();

if ($testonly) {
  if ($config_ok)  { exit(0); }  else { exit(1); }
}


### Open input sources

if ($fromstart) { open_input(0); } 
elsif ($tail) { open_input(-1); } 
else { open_input(0); }


### Daemonize the process, if -detach flag was specified

if ($detach)  { daemonize(); }


### Create pidfile - must be done after daemonization

if (defined($pidfile)) {

  if (open(PIDFILE, ">$pidfile")) {

    print PIDFILE "$$\n";
    close(PIDFILE);

  } else {

    if ($debuglevel >= LOG_CRIT) {
      log_msg(LOG_CRIT,
              "Can't open pidfile $pidfile for writing ($!), exiting!");
    }

    exit(1);

  }

}


### Set signal handlers

$refresh = 0;
$SIG{HUP} = \&hup_handler;

$softrefresh = 0;
$SIG{ABRT} = \&abrt_handler;

$dumpdata = 0;
$SIG{USR1} = \&usr1_handler;

$openlog = 0;
$SIG{USR2} = \&usr2_handler;

$terminate = 0;
$SIG{TERM} = \&term_handler;


### Set various global variables

$lastcleanuptime = $startuptime = time();
$processedlines = 0;


### Initialize input buffer

for (my $i = 0; $i < $bufsize; ++$i)  { $input_buffer[$i] = ""; }
$bufpos = -1;


### Initialize correlation list, context list, 
### buffer list, and child process list

%corr_list = ();
%context_list = ();
%children = ();


### Initialize event buffers

@events = ();
@pending_events = ();


### Initialize log-message buffer

@logmsgbuffer = ();


### If -intevents flag was specified, create generate the SEC_STARTUP event

if ($intevents)  { internal_event("SEC_STARTUP"); }


### The main loop - read lines from input stream and process them

for (;;) {

  my($line, $file, $ret);
  my($context, $conffile);

  # if there are pending events in the event buffer or the read buffer, 
  # read new line from there, otherwise read new line from input stream.

  if (scalar(@events)) { 

    $line = shift @events;
    $file = undef;

  } elsif (scalar(@readbuffer)) { 

    $line = shift @readbuffer;
    $file = shift @readbuffer;

  } else {

    read_line($line, $file);

  }

  if (defined($line)) {

    if ($intcontexts) {

      if (defined($file)) { $context = $inputsrc{$file}->{"context"}; } 
        else { $context = "_INTERNAL_EVENT"; }

      $context_list{$context} = $int_contexts{$context};

    }

    # update input buffer (it is implemented as a circular buffer, since
    # according to benchmarks an array queue using shift and push is slower)

    $bufpos = ($bufpos + 1) % $bufsize;
    $input_buffer[$bufpos] = $line;

    # process rules from configuration files

    foreach $conffile (@conffiles)  { process_rules($conffile); }

    if ($intcontexts)  { delete $context_list{$context}; }

    if (defined($file))  { ++$inputsrc{$file}->{"lines"}; }
    ++$processedlines;

  } elsif (!$file) {

    # if we didn't get new data and -tail option was specified, sleep 
    # for $poll_timeout seconds; if -notail option is active and all
    # input files have been closed, exit

    if ($tail) {

      # sleep with select()

      $ret = select(undef, undef, undef, $poll_timeout);

      if ((!defined($ret) || $ret < 0)  &&  $! != EINTR) {

        if ($debuglevel >= LOG_CRIT) {
          log_msg(LOG_CRIT, "Select error ($!), exiting!");
        }

        child_cleanup();
        exit(1);

      }

    } elsif (!grep($inputsrc{$_}->{"open"}, @inputfiles)) {

      # after generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT 
      # seconds, so that child processes that were triggered by SEC_SHUTDOWN 
      # have time to create a signal handler for SIGTERM if they wish

      if ($intevents) {
        internal_event("SEC_SHUTDOWN"); 
        sleep(TERMTIMEOUT);
      }

      child_cleanup();
      exit(0); 

    }

  }

  # search all lists, performing timed tasks associated with elements
  # and removing obsolete elements

  if (time() - $lastcleanuptime >= $cleantime) {

    process_lists();
    $lastcleanuptime = time();

  }

  # manage child processes

  if (scalar(%children))  { check_children(); }

  # check signal flags

  check_signals();

}
