~ubuntu-branches/ubuntu/breezy/sec/breezy : contents of sec.pl at revision 1

~ubuntu-branches/ubuntu/breezy/sec/breezy : (revision 1)
#!/usr/bin/perl -w
#
# SEC version 2.2.4 - sec.pl
# simple event correlation tool
#
# Copyright (C) 2000-2004 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
  $bufsize
  $bufpos
  $cleantime
  @calendar
  %children
  @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
  $logfile
  @logmsgbuffer
  $openlog
  @pending_events
  $pidfile
  $poll_timeout
  $processedlines
  $quoting
  @readbuffer
  $refresh
  $reopen_timeout
  $SEC_VERSION
  $separator
  $softrefresh
  $startuptime
  $syslogf
  $tail
  $terminate
  $testonly
  $timeout_script
  %variables
  $WIN32
);

$SEC_VERSION = "2.2.4";

use Getopt::Long;
use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END setsid);
use Fcntl;
use IO::Handle;
use Sys::Syslog;


# 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,
            "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>
  -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; }


# 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 NSUBSTR		=> 2;
use constant NREGEXP		=> 3;

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 SETCONTEXT		=> 8;
use constant ALIAS		=> 9;
use constant UNALIAS		=> 10;
use constant ADD		=> 11;
use constant FILL		=> 12;
use constant REPORT		=> 13;
use constant COPYCONTEXT	=> 14;
use constant EMPTYCONTEXT	=> 15;
use constant EVENT		=> 16;
use constant RESET		=> 17;
use constant ASSIGN		=> 18;
use constant EVAL		=> 19;

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

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

  $progname = $0;
  $progname =~ s/.*\///;

  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 (defined($logfile)) {

    $ltime = localtime(time());

    if ($refresh || $softrefresh || $openlog) { 
      push @logmsgbuffer, "$ltime: $msg\n"; 
    } else { 
      print LOGFILE "$ltime: $msg\n"; 
    }

  }

  if (defined($syslogf))  { syslog(SYSLOG_LEVELS->{$level}, $msg); }

  if (-t STDERR)  { print STDERR "$msg\n"; }

}



# 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 - value to be checked
# Action: return 1 if par1 consists of letters A-Za-z, 0 otherwise
#         ($value must consist of letters only for 1 to be returned,
#          no leading or trailing whitespace symbols are permitted)

sub is_alpha {

  my($value) = $_[0];

  return !($value =~ tr/[A-Za-z]//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 - pattern type (string)
#             par2 - pattern
#             par3 - the name of the configuration file
#             par4 - line number in configuration file
# Action: par1 and par2 will be analyzed and pair of integers
#         (pattern type, line count) 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);


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

    }

    eval { "" =~ /$pat/; };

    if ($@) {

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid regular expression '$pat'");
      }

      return (INVALIDVALUE, INVALIDVALUE);

    }

    if ($negate) { return (NREGEXP, $lines); } 
      else { return (REGEXP, $lines); }

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

    }

    if ($negate) { return (NSUBSTR, $lines); }
      else { return (SUBSTR, $lines); }

  } 

  else {

    if ($debuglevel >= LOG_ERR) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
              "Invalid pattern type '$pattype'");
    }

    return (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);


  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(/\s+/, $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(/\s+/, $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(/\s+/, $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 =~ /^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*(.*)/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(/\s+/, $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+)/i) {

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

    if (substr($variable, 0, 1) ne "%"  ||  
        length($variable) != 2  || !is_alpha(substr($variable, 1, 1)) ) {

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

      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, 1)); 

  }

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

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

    if (length($variable)) {

      if (substr($variable, 0, 1) ne "%"  ||  
          length($variable) != 2  || !is_alpha(substr($variable, 1, 1)) ) {

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

        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, 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 (substr($variable, 0, 1) ne "%"  ||  
        length($variable) != 2  || !is_alpha(substr($variable, 1, 1)) ) {

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

      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, 1), $value); 

  }

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

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

    if (substr($variable, 0, 1) ne "%"  ||
        length($variable) != 2  || !is_alpha(substr($variable, 1, 1)) ) {

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

      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, 1), $code); 

  }

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


  # 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 CODE 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)/) {

    $op1 = $1;
    $op1 =~ s/\\([\(\)])/$1/g;

    @{$result} = ( CODE, $op1 );

    return 1;

  }

  if ($context =~ /^\s*(.*\S)/) {

    $op1 = $1;
    $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($code, $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] == CODE) {

      if ($result->[$i+1] eq EXPRSYMBOL) { 

        $code = shift @expr;
        $code =~ s/\\([\(\)])/$1/g;

        $result->[$i+1] = $code; 

      }
 
      $i += 2;
 
    }

    else { ++$i; }

  }

  return 1;

}



# 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(/\s+/, $timespec);
  if (!length($parts[0]))  { shift @parts; }

  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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    $progname = (split(/\s+/, $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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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; }
    elsif (uc($ref->{"continue2"}) eq "TAKENEXT") { $whatnext2 = TAKENEXT; }
    elsif (uc($ref->{"continue2"}) eq "DONTCONT") { $whatnext2 = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue2"}, "'");
      }
      return 0; 
    }

    ($pattype2, $patlines2) = analyze_pattern($ref->{"ptype2"},
                              $ref->{"pattern2"}, $conffile, $lineno);

    if ($pattype2 == INVALIDVALUE)  { return 0; }

    $pattern2 = $ref->{"pattern2"};

    if ($pattype2 == SUBSTR  ||  $pattype2 == NSUBSTR) { 
      subst_specchar($pattern2); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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"})) { 

      if ($ref->{"context2"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context2"} = $1; 
        $contpreeval2 = 1;

      } else { $contpreeval2 = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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; }
    elsif (uc($ref->{"continue2"}) eq "TAKENEXT") { $whatnext2 = TAKENEXT; }
    elsif (uc($ref->{"continue2"}) eq "DONTCONT") { $whatnext2 = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue2"}, "'");
      }
      return 0; 
    }

    ($pattype2, $patlines2) = analyze_pattern($ref->{"ptype2"},
                              $ref->{"pattern2"}, $conffile, $lineno);

    if ($pattype2 == INVALIDVALUE)  { return 0; }

    $pattern2 = $ref->{"pattern2"};

    if ($pattype2 == SUBSTR  ||  $pattype2 == NSUBSTR) { 
      subst_specchar($pattern2); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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"})) { 

      if ($ref->{"context2"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context2"} = $1; 
        $contpreeval2 = 1;

      } else { $contpreeval2 = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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; }
    elsif (uc($ref->{"continue"}) eq "TAKENEXT") { $whatnext = TAKENEXT; }
    elsif (uc($ref->{"continue"}) eq "DONTCONT") { $whatnext = DONTCONT; }
    else {
      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 
                "Invalid continue value '", $ref->{"continue"}, "'");
      }
      return 0; 
    }

    ($pattype, $patlines) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    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"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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) = analyze_pattern($ref->{"ptype"},
                            $ref->{"pattern"}, $conffile, $lineno);

    if ($pattype == INVALIDVALUE)  { return 0; }

    $pattern = $ref->{"pattern"};

    if ($pattype == REGEXP  ||  $pattype == NREGEXP) { 
      $pattern = qr/$pattern/; 
    } else { 
      subst_specchar($pattern); 
    }

    if (exists($ref->{"context"})) { 

      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 

        $ref->{"context"} = $1; 
        $contpreeval = 1;

      } else { $contpreeval = 0; }

      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) {
        $ref->{"desc"} = "Suppress lines that match: $pattern";
      } else {
        $ref->{"desc"} = "Suppress lines that don't match: $pattern";
      }

    }

    $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 []
      if ($ref->{"context"} =~ /^\s*\[(.*)\]\s*$/) { 
        $ref->{"context"} = $1; 
      }

      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)
 
  %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);
  my($timestamp, $timestamp2);


  $pos2 = 0;
  $length = length($_[0]);
  $timestamp = localtime(time());
  $timestamp2 = time();

  for (;;) {

    $pos = index($_[0], "%", $pos2);

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

    $variable = substr($_[0], $pos + 1, 1);

    if ($variable eq "%") {

      substr($_[0], $pos, 2) = "%";
      $pos2 = $pos + 1;
      --$length;

    }

    elsif ($variable eq "s") {

      substr($_[0], $pos, 2) = $msg;
      $pos2 = $pos + length($msg);
      $length += $pos2 - $pos - 2;

    }

    elsif ($variable eq "t") {

      substr($_[0], $pos, 2) = $timestamp;
      $pos2 = $pos + length($timestamp);
      $length += $pos2 - $pos - 2;

    }

    elsif ($variable eq "u") {

      substr($_[0], $pos, 2) = $timestamp2;
      $pos2 = $pos + length($timestamp2);
      $length += $pos2 - $pos - 2;

    }

    elsif (exists($variables{$variable})) {

      substr($_[0], $pos, 2) = $variables{$variable};
      $pos2 = $pos + length($variables{$variable});
      $length += $pos2 - $pos - 2;

    }

    else { $pos2 = $pos + 1; }

    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,
                        "buffer" => "",
                        "Desc" => undef,
                        "Action" => undef,
                        "Action2" => undef };

    if ($collect_output) {

      close(WRITE_FH);
      $children{$pid}->{"fh"} = *READ_FH;

    }

    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,
                        "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] == 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;

    }

  }

}



# 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] == CODE) {

      push @{$dest_ref}, CODE;
      push @{$dest_ref}, $src_ref->[$i+1];
      $i += 2;

    } 

    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);
  my($variable, $value, $code, @evalresult, $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, replace '-symbols with `-symbols
      # in $text2 and put $text2 between '-symbols

      if ($quoting) { 

        $text2 =~ tr/'/`/;   # ' fix emacs parsing
        $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, replace '-symbols with `-symbols
      # in $text2 and put $text2 between '-symbols

      if ($quoting) { 

        $text2 =~ tr/'/`/;   # ' fix emacs parsing
        $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);

      valid_context($context);

      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"} = [];
        $context_list{$context}->{"Desc"} = $text;
        
      } else {

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

      }

      copy_actionlist($list, $context_list{$context}->{"Action"});

      $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] == SETCONTEXT) {

      $context = $actionlist->[$i+1];
      $lifetime = $actionlist->[$i+2];
      $list = $actionlist->[$i+3];

      substitute_var($context, $text);

      valid_context($context);

      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"} = [];
        $context_list{$context}->{"Desc"} = $text;

        copy_actionlist($list, $context_list{$context}->{"Action"});

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

      valid_context($context);

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

      valid_context($alias);

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

      valid_context($context);

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

      valid_context($context);

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

      valid_context($context);

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

      valid_context($context);

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

      valid_context($context);

      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'");
      }

      @evalresult = SEC::call_eval($code, 1);
      $evalok = shift @evalresult;

      if ($evalok) {

        $value = join("\n", @evalresult);

        if ($debuglevel >= LOG_DEBUG) {
          log_msg(LOG_DEBUG,
                  "Assigning value '$value' to variable '%$variable'");
        }

        $variables{$variable} = $value;

      } else {

        if ($debuglevel >= LOG_ERR) {
          log_msg(LOG_ERR, "Error evaluating code '$code':", $evalresult[0]);
        }

      }

      $i += 3;

    }

  }

}



# 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

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


  $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] == CODE) {

      $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] == 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;
  @{$subst_ref} = ();

  for (;;) {

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

    if ($i == $bufpos)  { last; }

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

  }

  if (@{$subst_ref} = ($line =~ /$regexp/)) { 

    unshift @{$subst_ref}, $line;   # create $0 that equals to $line
    return 1; 

  } else { 

    $subst_ref->[0] = $line;   # create $0 that equals to $line
    return 0; 

  }

}



# 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 

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] == CODE) { 

      subst_string($subst_ref, $ref->[$i+1], $token);
      $i += 2; 

    }

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

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

    }

  }

}



# 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 must be evaluated before the pattern match

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

      # if the rule can't be applied in current context 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;

      }

      copy_context($ref->{"Context"}, \@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 there are any backreference values available, 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"} == NREGEXP) {

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

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

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

    }

    # If match was found, process the event

    if ($match_found) {

      # Check if rule context is valid at the moment

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

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

        copy_context($ref->{"Context"}, \@context);

        if (scalar(@subst))  { subst_context(\@subst, \@context, '$'); }

        # if the rule can't be applied in current context 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 shows the usage of the rule
      # (just for statistical purposes)

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


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

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

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

        copy_actionlist($ref->{"Action"}, \@action);

        if (scalar(@subst)) { 

          subst_string(\@subst, $desc, '$'); 
          subst_actionlist(\@subst, \@action, '$');

        }

        # execute an action and don't save anything to lists

        execute_actionlist(\@action, $desc);

      }

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

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

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

        copy_actionlist($ref->{"Action"}, \@action);
        copy_actionlist($ref->{"Action2"}, \@action2);

        if (scalar(@subst)) { 

          subst_string(\@subst, $desc, $script, '$'); 
          subst_actionlist(\@subst, \@action, '$');
          subst_actionlist(\@subst, \@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 (!exists($corr_list{$key})  ||
            $time - $corr_list{$key}->{"Time"} > $ref->{"Window"}) {

          # 1) if this is first event, start the rule OR
          # 2) if we are outside of time window, we can consider previous
          #    application of this rule finished. So this event is again
          #    first one and rule will be started again

          copy_actionlist($ref->{"Action"}, \@action);

          if (scalar(@subst)) { subst_actionlist(\@subst, \@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();

        # 1) if this is first event, start the rule OR
        # 2) if we are outside of time window, we can consider previous
        #    application of this rule finished. So this event is again 
        #    first one and rule will be started again

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

          copy_actionlist($ref->{"Action"}, \@action);
          copy_actionlist($ref->{"Action2"}, \@action2);
          copy_context($ref->{"Context2"}, \@context2);

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

          if (scalar(@subst)) {

            subst_actionlist(\@subst, \@action, '$');

            if ($ref->{"PatType2"} == REGEXP  ||
                $ref->{"PatType2"} == NREGEXP) { 

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

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

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

            } else {

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

            }

          }

          $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 we are outside of time window and event is not removed from
        # corr_list, it is still not resolved and action must be executed
        # after that we can consider previous application of the rule finished

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

        }

        # Since this is first event, start the rule

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

          copy_actionlist($ref->{"Action"}, \@action);
          copy_actionlist($ref->{"Action2"}, \@action2);
          copy_context($ref->{"Context2"}, \@context2);

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

          if (scalar(@subst)) {

            subst_actionlist(\@subst, \@action, '$');

            if ($ref->{"PatType2"} == REGEXP  ||
                $ref->{"PatType2"} == NREGEXP) { 

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

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

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

            } else { 

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

            }

          }

          $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();

        # Since this is first event, start the rule by creating
        # corr_list element

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

          copy_actionlist($ref->{"Action"}, \@action);

          if (scalar(@subst)) { subst_actionlist(\@subst, \@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 an action

          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 was executed in the past and this corr_list 
          # element was used to suppress post-action events.
          # So current event is again first one and rule will be restarted

          copy_actionlist($ref->{"Action"}, \@action);

          if (scalar(@subst)) { subst_actionlist(\@subst, \@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();

        # Since this is first event, start the rule by creating
        # corr_list element

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

          copy_actionlist($ref->{"Action"}, \@action);
          copy_actionlist($ref->{"Action2"}, \@action2);

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

          if (scalar(@subst)) { 

            subst_actionlist(\@subst, \@action, '$');
            subst_string(\@subst, $desc2, '$'); 
            subst_actionlist(\@subst, \@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
            # an action 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 an action.

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

            # since action was just executed we can consider previous
            # application of this rule finished. So this event is again 
            # first one and rule will be started again

            copy_actionlist($ref->{"Action"}, \@action);
            copy_actionlist($ref->{"Action2"}, \@action2);

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

            if (scalar(@subst)) { 

              subst_actionlist(\@subst, \@action, '$');
              subst_string(\@subst, $desc2, '$'); 
              subst_actionlist(\@subst, \@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 events associated with the rule 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 must be evaluated before the pattern match

    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 there were any backreferences, 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 == NREGEXP) {

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

    } elsif ($pattype2 == NSUBSTR) {

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

    }

    # If match was found, process the event

    if ($match_found) {

      # Check if rule context is valid at the moment

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

        copy_context($ref->{"Context2"}, \@context2);

        if (scalar(@subst))  { subst_context(\@subst, \@context2, '$'); }

        if (!valid_formula(\@context2))  { next; }  

      }


      # --- PAIR rule

      if ($type == PAIR) {

        # if we are inside time window, execute 2nd action,
        # otherwise do nothing

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

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

          copy_actionlist($ref->{"Action2"}, \@action2);

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

          if (scalar(@subst)) { 

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

          }

          execute_actionlist(\@action2, $desc2);

        }

        # now we can consider rule application finished, and list
        # elements concerning the event can be deleted 

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

      }

      # --- PAIR_W_WINDOW rule

      elsif ($type == PAIR_W_WINDOW) {

        # to achieve good event ordering, execute 2nd action 
        # and delete list elements without checking the window

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

        copy_actionlist($ref->{"Action2"}, \@action2);

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

        if (scalar(@subst)) { 

          subst_string(\@subst, $desc2, '$'); 
          subst_actionlist(\@subst, \@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 (scalar(@{$ref->{"Context"}})) {

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

    }

    # 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 (or more) of the 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; }

    # 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 rule application is finished, so 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 rule application is finished and list element
        # is 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] == 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;

    }

    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 == NSUBSTR) { 
    return "negative substring for $lines line(s): $pattern"; 
  } 

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

  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] == CODE) {

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

      $i += 2;
    }

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

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

      $i += 2;
    }

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

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

      ++$i;
    }

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

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

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

      ++$i;
    }

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

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

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

      ++$i;
    }

  }

  $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 "Date of dump: ", scalar(localtime($time)), "\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 (defined($inputsrc{$file}->{"fh"})) { 
      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

  print DUMPFILE "Pending events that are generated by rules:\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";

  }

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


  # print the list of active event correlation operations

  $i = 0;
  print DUMPFILE "List of active 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 active 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 "Running children:\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";
    }

    print DUMPFILE "\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, $event);
  my($pipe_buffer_len, $nbytes);


  $pipe_buffer_len = length($children{$pid}->{"buffer"});

  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}->{"fh"} = undef;
      last; 

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

    # try to read from the pipe

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

    # if sysread() failed because of the caught signal, check for new data,
    # otherwise close the pipe and quit the read-loop;
    # 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)) { 

      # posix allows read(2) to be interrupted by a signal and return -1,
      # with some bytes already been read into read buffer; although most
      # unices never behave that way, re-evaluate $pipe_buffer_len

      if ($! == EINTR) { 

        $pipe_buffer_len = length($children{$pid}->{"buffer"});

      } else {

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

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

      }

    } elsif ($nbytes == 0) { 

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

    } else {

      $pipe_buffer_len += $nbytes;

    }

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

    for (;;) {

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

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

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

      $pipe_buffer_len -= $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 (!defined($children{$pid}->{"fh"})  &&  $pipe_buffer_len > 0) {

    $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 (defined($children{$pid}->{"fh"}))  { 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($?)) {

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

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

      # find the child exit code

      $exitcode = $? >> 8;

      # 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 (defined($inputsrc{$file}->{"fh"})) {
        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)) {

      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)) {

      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,
                                "buffer" => "",
                                "scriptexec" => 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, 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 ($!)");
    }

    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 ($!)");
      }

      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 (preserving '\n' at the end
#         of the line). If input stream has no complete line available, 
#         an empty string will be returned. If read system call fails, 
#         function returns undef.

sub read_line_from_file {

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


  # if there is a complete line in read buffer (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 + 1);
    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, log an error message and return undef

      if ($! != EINTR) { 

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

        return undef;

      } 

    } elsif ($nbytes == 0) { 

      # if we have reached EOF and -tail mode is set, return an empty string;
      # if -notail mode is active, close the file and return the content of 
      # the file buffer (note that the buffer must contain bytes between
      # last newline in the file and EOF, and if there are no such bytes,
      # the buffer contains an empty string).

      if ($tail)  { return ""; }

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

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

  } 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 an empty
      # string, otherwise log an error message and return undef

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

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

      return undef;

    } elsif ($ret == 0) {

      # if we have reached EOF and -tail mode is set, return an empty string;
      # if -notail mode is active, close the file and return the content of 
      # the file buffer (note that the buffer must contain bytes between
      # last newline in the file and EOF, and if there are no such bytes,
      # the buffer contains an empty string).

      if ($tail)  { return ""; }

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

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

    # 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 ($!)");
        }

        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)"); 
      }

      return undef;

    }

  }

  # if the read buffer contains a newline, cut the first line from 
  # the read buffer and return it, otherwise return an empty string
  # (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 + 1);
    substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = "";
    return $line;

  }

  return "";

}



# Parameters: - 
# Action: read next line from input stream, and return a 2-element
#         array (line, file) where file is the name of the file where 
#         line was read from. If a line comes from an event buffer,
#         the 2nd element of the array is undef. If there was no new
#         data both in input files and event buffer, an array
#         (undef, undef) is returned.

sub read_line {

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


  # if there are pending events in the event buffer,
  # return the first event from the buffer

  if (scalar(@events)) { 

    $line = shift @events;
    return ($line, undef);

  }

  # if there are lines in the read buffer from a previous invocation
  # of this function, return the first line from the buffer

  if (scalar(@readbuffer)) { 

    $line = shift @readbuffer;
    $file = shift @readbuffer;
    return ($line, $file); 

  }

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

  $time = time();

  foreach $file (@inputfiles) {

    # 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 (defined($inputsrc{$file}->{"fh"})) {
      $line = read_line_from_file($file);
    } else {
      $line = "";
    }

    if (!defined($line)) {

      # if we experienced an IO error, close the file

      if ($debuglevel >= LOG_ERR) {
        log_msg(LOG_ERR, "Closing input file $file because of IO error");
      }

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

    } 

    elsif (length($line)) {

      # if we received new data, remove the trailing newline if it is 
      # present, and write the data to the read buffer; also update
      # time-related variables and call external script, if necessary

      chomp($line);

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

      if (defined($input_timeout) || defined($reopen_timeout)) {

        $inputsrc{$file}->{"lastread"} = $time;
        $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 there were no new bytes in the file and -notail mode is
      # active, skip the following shuffle and timeout checks (i.e.,
      # -input_timeout, -timeout_script, and -reopen_timeout options
      # are ignored when -notail is set)

      if (!$tail)  { next; }

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

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

        $shuffled = input_shuffled($file);

        if (!defined($shuffled)) {

          if ($debuglevel >= LOG_ERR) {
            log_msg(LOG_ERR, "Closing input file $file because of IO error");
          }

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

        } elsif ($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}->{"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 (defined($inputsrc{$file}->{"fh"})) {
          close($inputsrc{$file}->{"fh"});
        }

        $inputsrc{$file}->{"fh"} = open_input_file($file, -1);
        $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, undef)

  if (scalar(@readbuffer)) {

    $line = shift @readbuffer;
    $file = shift @readbuffer;
    return ($line, $file); 

  }

  return (undef, undef);

}



# 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($time, $line, $file);
  my($context, $conffile, $ret);

  # if there are pending events in event buffer, read new line
  # from event buffer, otherwise read new line from input stream.

  $time = time();
  ($line, $file) = read_line();

  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

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

    # process rules from configuration files and perform timed tasks

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

    if ($intcontexts)  { delete $context_list{$context}; }

    if (defined($file))  { ++$inputsrc{$file}->{"lines"}; }
    ++$processedlines;

  } else {

    # 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 { defined($inputsrc{$_}->{"fh"}) } @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 and handle signals

  check_children();
  check_signals();

}