xref: /dports/sysutils/sec/sec-2.9.0/sec

#!/usr/local/bin/perl -w
#
# SEC (Simple Event Correlator) 2.9.0 - sec
# Copyright (C) 2000-2021 Risto Vaarandi
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
#

package main::SEC;

# Parameters: par1 - perl code to be evaluated
#             par2 - if set to 0, the code will be evaluated in scalar
#                    context; if 1, list context is used for evaluation
# Action: calls eval() for the perl code par1, and returns an array with
#         the eval() return value(s). The first element of the array
#         indicates whether the code was evaluated successfully (i.e.,
#         the compilation didn't fail). If code evaluation fails, the
#         first element of the return array contains the error string.

sub call_eval {

  my($code, $listcontext) = @_;
  my($ok, @result);

  $ok = 1;

  if ($listcontext) {
    @result = eval $code;
  } else {
    $result[0] = eval $code;
  }

  if ($@) {
    $ok = 0;
    chomp($result[0] = $@);
  }

  return ($ok, @result);

}

######################################################################

package main;

use strict;

##### List of global variables #####

use vars qw(
  @actioncopyfunc
  @actionsubstfunc
  $blocksize
  $bufpos
  $bufsize
  @calendar
  %cfset2cfile
  $check_timeout
  %children
  $childterm
  $cleantime
  @conffilepat
  @conffiles
  %config_ltimes
  %config_mtimes
  %config_options
  %configuration
  %context_list
  %corr_list
  $debuglevel
  $debuglevelinc
  $detach
  $dumpdata
  $dumpfile
  $dumpfjson
  $dumpfts
  %dyninputfiles
  @events
  %event_buffer
  $evstoresize
  @execactionfunc
  $fromstart
  @groupnames
  $help
  @inputfilepat
  @inputfiles
  %inputsrc
  @input_buffer
  %input_buffers
  @input_sources
  $input_timeout
  $intcontextname
  $intcontexts
  $intevents
  $int_context
  $JSONAVAIL
  $jointbuf
  $keepopen
  $lastcleanuptime
  $lastconfigload
  $logfile
  $loghandle
  $logopen
  @maincfiles
  @matchegrpfunc
  @matchfunc
  @matchrulefunc
  $openlog
  %output_files
  %output_tcpconn
  %output_tcpsock
  %output_udgram
  %output_udpsock
  %output_ustrconn
  %output_ustream
  @pending_events
  $pidfile
  %pmatch_cache
  $poll_timeout
  $processedlines
  @processrulefunc
  $quoting
  $rcfile_status
  @readbuffer
  $refresh
  $reopen_timeout
  $ruleperf
  $rwfifo
  $SEC_COPYRIGHT
  $SEC_LICENSE
  $SEC_USAGE
  $SEC_VERSION
  $SYSLOGAVAIL
  $sec_options
  $sigreceived
  $socket_timeout
  $softrefresh
  $startuptime
  $syslogf
  $syslogopen
  $tail
  %terminate
  $testonly
  $timeout_script
  $timevar_update
  $umask
  $username
  %variables
  $version
  $WIN32
);


##### Load modules and set some global variables #####

use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END
             setsid ctermid getpgrp tcgetpgrp setuid setgid strftime);
use Getopt::Long;
use Fcntl;
use Socket;
use IO::Handle;

# check if Sys::Syslog and JSON::PP modules are available

$SYSLOGAVAIL = eval { require Sys::Syslog };
$JSONAVAIL = eval { require JSON::PP };

# check if the platform is win32

$WIN32 = ($^O =~ /win/i  &&  $^O !~ /cygwin/i  &&  $^O !~ /darwin/i);

# set version and usage variables

$SEC_VERSION = "SEC (Simple Event Correlator) 2.9.0";
$SEC_COPYRIGHT = "Copyright (C) 2000-2021 Risto Vaarandi";

$SEC_USAGE = qq!Usage: $0 [options]

Options:
  --conf=<file pattern> ...
  --input=<file pattern>[=<context>] ...
  --input-timeout=<input timeout>
  --timeout-script=<timeout script>
  --reopen-timeout=<reopen timeout>
  --check-timeout=<check timeout>
  --poll-timeout=<poll timeout>
  --socket-timeout=<socket timeout>
  --blocksize=<io block size>
  --bufsize=<input buffer size>
  --evstoresize=<event store size>
  --cleantime=<clean time>
  --log=<logfile>
  --syslog=<facility>
  --debug=<debuglevel>
  --pid=<pidfile>
  --dump=<dumpfile>
  --user=<username>
  --group=<groupname> ...
  --umask=<mode>
  --ruleperf, --noruleperf
  --dumpfts, --nodumpfts
  --dumpfjson, --nodumpfjson
  --quoting, --noquoting
  --tail, --notail
  --fromstart, --nofromstart
  --detach, --nodetach
  --jointbuf, --nojointbuf
  --keepopen, --nokeepopen
  --rwfifo, --norwfifo
  --childterm, --nochildterm
  --intevents, --nointevents
  --intcontexts, --nointcontexts
  --testonly, --notestonly
  --help, -?
  --version
!;

$SEC_LICENSE = q!
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
!;


##### List of internal constants #####

use constant INVALIDVALUE 	=> -1;

use constant SINGLE 		=> 0;
use constant SINGLE_W_SUPPRESS	=> 1;
use constant SINGLE_W_SCRIPT	=> 2;
use constant PAIR		=> 3;
use constant PAIR_W_WINDOW	=> 4;
use constant SINGLE_W_THRESHOLD	=> 5;
use constant SINGLE_W_2_THRESHOLDS => 6;
use constant EVENT_GROUP	=> 7;
use constant SUPPRESS		=> 8;
use constant CALENDAR		=> 9;
use constant JUMP		=> 10;

use constant SUBSTR		=> 0;
use constant REGEXP		=> 1;
use constant PERLFUNC		=> 2;
use constant CACHED		=> 3;
use constant NSUBSTR		=> 4;
use constant NREGEXP		=> 5;
use constant NPERLFUNC		=> 6;
use constant NCACHED		=> 7;
use constant TVALUE		=> 8;

use constant DONTCONT		=> 0;
use constant TAKENEXT		=> 1;
use constant GOTO		=> 2;
use constant ENDMATCH		=> 3;

use constant NONE		=> 0;
use constant LOGONLY		=> 1;
use constant WRITE		=> 2;
use constant WRITEN		=> 3;
use constant CLOSEF		=> 4;
use constant OWRITECL		=> 5;
use constant UDGRAM		=> 6;
use constant CLOSEUDGR		=> 7;
use constant USTREAM		=> 8;
use constant CLOSEUSTR		=> 9;
use constant UDPSOCK		=> 10;
use constant CLOSEUDP		=> 11;
use constant TCPSOCK		=> 12;
use constant CLOSETCP		=> 13;
use constant SHELLCOMMAND	=> 14;
use constant COMMANDEXEC	=> 15;
use constant SPAWN		=> 16;
use constant SPAWNEXEC		=> 17;
use constant CSPAWN		=> 18;
use constant CSPAWNEXEC		=> 19;
use constant PIPE		=> 20;
use constant PIPEEXEC		=> 21;
use constant CREATECONTEXT	=> 22;
use constant DELETECONTEXT	=> 23;
use constant OBSOLETECONTEXT	=> 24;
use constant SETCONTEXT		=> 25;
use constant ALIAS		=> 26;
use constant UNALIAS		=> 27;
use constant ADD		=> 28;
use constant PREPEND		=> 29;
use constant FILL		=> 30;
use constant REPORT		=> 31;
use constant REPORTEXEC		=> 32;
use constant COPYCONTEXT	=> 33;
use constant EMPTYCONTEXT	=> 34;
use constant POP		=> 35;
use constant SHIFT		=> 36;
use constant EXISTS		=> 37;
use constant GETSIZE		=> 38;
use constant GETALIASES		=> 39;
use constant GETLIFETIME	=> 40;
use constant SETLIFETIME	=> 41;
use constant GETCTIME		=> 42;
use constant SETCTIME		=> 43;
use constant EVENT		=> 44;
use constant TEVENT		=> 45;
use constant CEVENT		=> 46;
use constant RESET		=> 47;
use constant GETWINPOS		=> 48;
use constant SETWINPOS		=> 49;
use constant ASSIGN		=> 50;
use constant ASSIGNSQ		=> 51;
use constant FREE		=> 52;
use constant EVAL		=> 53;
use constant CALL		=> 54;
use constant LCALL		=> 55;
use constant REWRITE		=> 56;
use constant ADDINPUT		=> 57;
use constant DROPINPUT		=> 58;
use constant SIGEMUL		=> 59;
use constant VARIABLESET	=> 60;
use constant IF			=> 100;
use constant WHILE		=> 101;
use constant BREAK		=> 102;
use constant CONTINUE		=> 103;

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

use constant EXPRSYMBOL		=> "\0";

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

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

use constant SEPARATOR		=> " | ";

use constant TERMTIMEOUT	=> 3;
use constant BATCHREADLIMIT	=> 8192;

use constant SECEVENT_INT_CONTEXT	=> "SEC_INTERNAL_EVENT";
use constant SYNEVENT_INT_CONTEXT	=> "_INTERNAL_EVENT";
use constant FILEVENT_INT_CONTEXT_PREF	=> "_FILE_EVENT_";

use constant DEFAULT_POLLTIMEOUT	=> 0.1;
use constant DEFAULT_SOCKETTIMEOUT	=> 60;
use constant DEFAULT_BLOCKSIZE		=> 8192;
use constant DEFAULT_CLEANTIME		=> 1;
use constant DEFAULT_DUMPFILE		=> "/tmp/sec.dump";


###############################################################
# ------------------------- FUNCTIONS -------------------------
###############################################################

##############################
# Functions related to logging
##############################


# Parameters: par1 - name of the logfile
# Action: logfile will be opened. Filehandle of the logfile will be
#         saved to the global filehandle $loghandle.

sub open_logfile {

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

  if (open($loghandle, ">>$logfile")) {
    select($loghandle);
    $| = 1;
    select(STDOUT);
    $logopen = 1;
  } else {
    print STDERR "Can't open logfile $logfile ($!)\n";
    $logopen = 0;
  }
}


# Parameters: par1 - syslog facility
# Action: open connection to the system logger with the facility par1.

sub open_syslog {

  my($facility) = $_[0];
  my($progname);

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

  eval { Sys::Syslog::openlog($progname, "pid", $facility) };

  if ($@) {
    print STDERR "Can't connect to syslog ($@)\n";
    $syslogopen = 0;
    return;
  }

  $syslogopen = 1;
}


# Parameters: par1 - severity of the log message
#             par2, par3, ... - strings to be logged
# Action: if par1 is smaller or equal to the current logging level (i.e.,
#         the message must be logged), then strings par2, par3, ...
#         will be equipped with timestamp and written to $loghandle and/or
#         forwarded to the system logger as a single line. If STDERR is
#         connected to terminal, message will also be written there.

sub log_msg {

  my($level) = shift(@_);
  my($ltime, $msg);

  if ($debuglevel < $level)  { return; }

  if (!$logopen && !$syslogopen && ! -t STDERR)  { return; }

  $msg = join(" ", @_);

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

  if ($logopen) {
    $ltime = localtime(time());
    print $loghandle "$ltime: $msg\n";
  }

  # if call to syslog() fails (e.g., because syslog daemon is going through
  # restart), older versions of Sys::Syslog will die, thus we use eval

  if ($syslogopen) {
    eval { Sys::Syslog::syslog(SYSLOG_LEVELS->{$level}, $msg) };
  }

}


#######################################################
# Functions related to configuration file(s) processing
#######################################################


# Parameters: par1, par2, .. - strings
# Action: All 2-byte substrings in par1, par2, .. that denote special
#         symbols ("\n", "\t", ..) will be replaced with corresponding
#         special symbols

sub subst_specchar {

  my(%specchar, $string);

  $specchar{"0"} = "";
  $specchar{"n"} = "\n";
  $specchar{"r"} = "\r";
  $specchar{"s"} = " ";
  $specchar{"t"} = "\t";
  $specchar{"\\"} = "\\";

  foreach $string (@_) {
    $string =~ s/\\(0|n|r|s|t|\\)/$specchar{$1}/g;
  }

}


# Parameters: par1 - string that is checked for match variables
#             par2, .. - one or more tokens that match variables begin with
# Action: return 1 if the string par1 contains match variables, 0 otherwise

sub contains_matchvars {

  my($string) = shift @_;
  my($token, $string2, %subst);

  # invoke subst_string() function for the input string and empty match
  # value hash - if the string contains match variables, they are replaced
  # with empty strings, and the result is different from the original string

  foreach $token (@_) {
    $string2 = $string;
    subst_string(\%subst, $string2, $token);
    if ($string ne $string2)  { return 1; }
  }

  return 0;

}


# Parameters: par1 - reference to a context expression
#             par2, .. - one or more tokens that match variables begin with
# Action: return 1 if expression par1 contains match variables, 0 otherwise

sub volatile_context {

  my($ref) = shift @_;
  my($i, $j, $elem);

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

  while ($i < $j) {

    if ($ref->[$i] == OPERAND || $ref->[$i] == ECODE
                              || $ref->[$i] == VARSET) {
      if (contains_matchvars($ref->[$i+1], @_))  { return 1; }
      $i += 2;
    }

    elsif ($ref->[$i] == EXPRESSION) {
      if (volatile_context($ref->[$i+1], @_))  { return 1; }
      $i += 2;
    }

    elsif ($ref->[$i] == CCODE || $ref->[$i] == CCODE2) {
      foreach $elem (@{$ref->[$i+1]}) {
        if (contains_matchvars($elem, @_))  { return 1; }
      }
      $i += 3;
    }

    else { ++$i; }

  }

  return 0;

}


# Parameters: par1 - expression
#             par2 - reference to an array
# Action: parentheses and their contents will be replaced with special
#         symbols EXPRSYMBOL in par 1. The expressions inside parentheses
#         will be returned in par2. Previous content of the array par2
#         is erased. If par1 was parsed successfully, the modified par1
#         will be returned, otherwise undef is returned.

sub replace_subexpr {

  my($expression, $expr_ref) = @_;
  my($i, $j, $l, $pos);
  my($char, $prev);

  @{$expr_ref} = ();

  $i = 0;
  $j = 0;
  $l = length($expression);
  $pos = undef;
  $prev = "";

  while ($i < $l) {

    # process expression par1 from the start and inspect every symbol,
    # adding 1 to $j for every '(' and subtracting 1 for every ')';
    # if a parenthesis is masked with a backslash, it is ignored

    $char = substr($expression, $i, 1);

    if ($prev ne "\\") {
      if ($char eq "(")  { ++$j; }  elsif ($char eq ")")  { --$j; }
    }

    # After observing first '(' save its position to $pos;
    # after observing its counterpart ')' replace everything
    # from '(' to ')' with EXPRSYMBOL (including possible nested
    # expressions), and save the content of parentheses;
    # if at some point $j becomes negative, the parentheses must
    # be unbalanced

    if ($j == 1  &&  !defined($pos))  { $pos = $i; }

    elsif ($j == 0  &&  defined($pos)) {

      # take symbols starting from position $pos+1 (next symbol after
      # '(') up to position $i-1 (the symbol before ')'), and save
      # the symbols to array

      push @{$expr_ref}, substr($expression, $pos + 1, $i - $pos - 1);

      # replace both the parentheses and the symbols between them
      # with EXPRSYMBOL

      substr($expression, $pos, $i - $pos + 1) = EXPRSYMBOL;

      # set the variables according to changes in expression

      $i = $pos;
      $l = length($expression);
      $pos = undef;
      $char = "";

    }

    elsif ($j < 0)  { return undef; }    # extra ')' was found

    $prev = $char;

    ++$i;

  }

  # if the parsing ended with non-zero $j, the parentheses were unbalanced

  if ($j == 0)  { return $expression; }  else { return undef; }

}


# Parameters: par1 - continue value (string)
#             par2 - the name of the configuration file
#             par3 - line number in configuration file
# Action: par1 will be analyzed and the integer continue value with
#         an optional jump label will be returned.
#         If errors are found when analyzing par1, error message
#         about improper line par3 in configuration file will be logged.

sub analyze_continue {

  my($continue, $conffile, $lineno) = @_;

  if (uc($continue) eq "TAKENEXT")  { return (TAKENEXT, undef); }
  elsif (uc($continue) eq "DONTCONT")  { return (DONTCONT, undef); }
  elsif (uc($continue) eq "ENDMATCH")  { return (ENDMATCH, undef); }
  elsif ($continue =~ /^goto\s+(.*\S)/i)  { return (GOTO, $1); }

  log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
          "Invalid continue value '$continue'");
  return INVALIDVALUE;

}


# Parameters: par1 - pattern type (string)
#             par2 - pattern
#             par3 - the name of the configuration file
#             par4 - line number in configuration file
#             par5 - if we are dealing with the second pattern of Pair*
#                    rule, par5 contains the type of the first pattern
# Action: par1 and par2 will be analyzed and tuple of integers
#         (pattern type, line count, compiled pattern) will be returned
#         (line count shows how many lines the pattern is designed to match).
#         If pattern is a second regular expression pattern of Pair rule which
#         contains match variables, the expression will not be compiled and
#         a corresponding flag is added to the return list.
#         If errors are found when analyzing par1 and par2, error message
#         about improper line par4 in configuration file will be logged.

sub analyze_pattern {

  my($pattype, $pat, $conffile, $lineno, $fptype) = @_;
  my($negate, $lines, $pat2, $ncomp);
  my($evalok, $retval);

  if ($pattype =~ /^(n?)regexp(?:0*([1-9][0-9]*))?$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }
    if (defined($2))  { $lines = $2; }  else { $lines = 1; }

    if ($bufsize && $lines > $bufsize) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Pattern type '$pattype' is designed to match $lines lines,",
              "please set --bufsize command line option to at least $lines");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    if (!defined($fptype) || $fptype == TVALUE || $fptype == SUBSTR ||
        $fptype == NSUBSTR || !contains_matchvars($pat, '$')) {

      $pat2 = eval { qr/$pat/ };

      if ($@) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid regular expression '$pat':", $@);
        return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
      }

    } else {
      $pat2 = $pat;
      $ncomp = 1;
    }

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

  } elsif ($pattype =~ /^(n?)substr(?:0*([1-9][0-9]*))?$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }
    if (defined($2))  { $lines = $2; }  else { $lines = 1; }

    if ($bufsize && $lines > $bufsize) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Pattern type '$pattype' is designed to match $lines lines,",
              "please set --bufsize command line option to at least $lines");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    subst_specchar($pat);

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

  } elsif ($pattype =~ /^(n?)perlfunc(?:0*([1-9][0-9]*))?$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }
    if (defined($2))  { $lines = $2; }  else { $lines = 1; }

    if ($bufsize && $lines > $bufsize) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Pattern type '$pattype' is designed to match $lines lines,",
              "please set --bufsize command line option to at least $lines");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    ($evalok, $retval) = SEC::call_eval($pat, 0);

    if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid function '$pat', eval didn't return a code reference:",
              defined($retval)?"$retval":"undef");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    if ($negate) { return (NPERLFUNC, $lines, $retval); }
      else { return (PERLFUNC, $lines, $retval); }

  } elsif ($pattype =~ /^(n?)cached$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }

    if ($pat !~ /^[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Invalid cached pattern name '$pat':",
                       "the name does not have the form",
                       "<letter>[<letter>|<digit>|<underscore>]...");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    if ($negate) { return (NCACHED, 1, $pat); }
      else { return (CACHED, 1, $pat); }

  } elsif ($pattype =~ /^tvalue$/i) {

    if (uc($pat) ne "TRUE"  &&  uc($pat) ne "FALSE") {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid truth value '$pat'");
      return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);
    }

    return (TVALUE, 1, uc($pat) eq "TRUE");

  }

  log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
          "Invalid pattern type '$pattype'");
  return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE);

}


# Parameters: par1 - pattern type
#             par2 - variable map (string)
#             par3 - reference to the variable map hash
#             par4 - the name of the configuration file
#             par5 - line number in configuration file
# Action: variable map par2 will be analyzed and saved into the hash par3.
#         If no errors are detected, 1 is returned. Otherwise error message
#         about improper line par5 in configuration file will be logged,
#         and 0 is returned. If the pattern type does not assume a variable
#         map (e.g., TValue), par3 will be set to empty hash, a warning is
#         logged and 1 is returned.

sub analyze_varmap {

  my($pattype, $varmap, $maphash_ref, $conffile, $lineno) = @_;
  my(@varmap, $mapping);

  %{$maphash_ref} = ();

  if ($pattype != REGEXP && $pattype != PERLFUNC) {
      log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
      "Variable maps are supported for RegExp and PerlFunc patterns only,",
      "ignoring variable map '$varmap'");
      return 1;
  }

  @varmap = split(/\s*;\s*/, $varmap);

  foreach $mapping (@varmap) {
    if ($mapping =~ /^\s*([[:alpha:]]\w*)(?:\s*=\s*0*([0-9]+))?\s*$/) {
      $maphash_ref->{"$1"} = $2;
    } else {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid variable map '$varmap':",
              "the variable mapping '$mapping' does not have the form",
              "<letter>[<letter>|<digit>|<underscore>]... [= <number>]");
      return 0;
    }
  }

  return 1;

}


# Parameters: par1 - event group pattern type (string)
#             par2 - event group pattern
#             par3 - the name of the configuration file
#             par4 - line number in configuration file
# Action: par1 and par2 will be analyzed and tuple of integers
#         (pattern type, compiled pattern) will be returned.
#         If errors are found when analyzing par1 and par2, error message
#         about improper line par4 in configuration file will be logged.

sub analyze_eventgroup_pattern {

  my($pattype, $pat, $conffile, $lineno) = @_;
  my($negate, $pat2);
  my($evalok, $retval);

  if ($pattype =~ /^(n?)regexp$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }

    $pat2 = eval { qr/$pat/ };

    if ($@) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid regular expression '$pat':", $@);
      return (INVALIDVALUE, INVALIDVALUE);
    }

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

  } elsif ($pattype =~ /^(n?)substr$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }

    subst_specchar($pat);

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

  } elsif ($pattype =~ /^(n?)perlfunc$/i) {

    if (length($1))  { $negate = 1; }  else { $negate = 0; }

    ($evalok, $retval) = SEC::call_eval($pat, 0);

    if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid function '$pat', eval didn't return a code reference:",
              defined($retval)?"$retval":"undef");
      return (INVALIDVALUE, INVALIDVALUE);
    }

    if ($negate) { return (NPERLFUNC, $retval); }
      else { return (PERLFUNC, $retval); }

  }

  log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
          "Invalid event group pattern type '$pattype'");
  return (INVALIDVALUE, INVALIDVALUE);

}


# Parameters: par1, par2, .. - strings
# Action: for each string, remove the outer pair of parens and backslashes
#         from the front of other parens

sub process_action_parens {

  my($string);

  foreach $string (@_) {
    if ($string =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $string = $1; }
    $string =~ s/\\([()])/$1/g;
  }
}


# Parameters: par1 - action
#             par2 - the name of the configuration file
#             par3 - line number in configuration file
#             par4 - rule ID
#             par5 - action with masked subexpressions
#             par6 - list of subexpressions
# Action: par1 will be analyzed and pair of integers
#         (action type, action description) will be returned. If errors
#         are found when analyzing par1, error message about improper
#         line par3 in configuration file will be logged.

sub analyze_action {

  my($action, $conffile, $lineno, $ruleid, $action2, $list) = @_;
  my($keyword, $file, $fpos, $peer, $cmdline, $signal);
  my($sign, $rule, $count);
  my($actionlist, @action);
  my($actionlist2, @action2);
  my($createafter, $event, $timestamp);
  my($lifetime, $context, $alias, $entry);
  my($variable, $value, $code, $codeptr, $params, $evalok, $op);

  if ($action =~ /^none$/i)  { return NONE; }

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

    $event = defined($1)?$1:"";
    process_action_parens($event);
    if (!length($event))  { $event = "%s"; }

    return (LOGONLY, $event);
  }

  elsif ($action =~ /^(write|writen|owritecl|udgram|ustream)\s+(\S+)(?:\s+(.*\S))?$/i) {

    $keyword = lc($1);
    $file = $2;
    $event = defined($3)?$3:"";

    if ($WIN32 && ($keyword eq "udgram" || $keyword eq "ustream")) {
      log_msg(LOG_ERR, "$keyword action is not supported on Win32");
      return INVALIDVALUE;
    }

    process_action_parens($file, $event);

    if (!length($file)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty filename given for $keyword action");
      return INVALIDVALUE;
    }

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

    if ($keyword eq "write") { return (WRITE, $file, $event); }
    elsif ($keyword eq "writen") { return (WRITEN, $file, $event); }
    elsif ($keyword eq "owritecl") { return (OWRITECL, $file, $event); }
    elsif ($keyword eq "udgram") { return (UDGRAM, $file, $event); }
    else { return (USTREAM, $file, $event); }
  }

  elsif ($action =~ /^(closef|closeudgr|closeustr|dropinput)\s+(\S+)$/i) {

    $keyword = lc($1);
    $file = $2;

    if ($WIN32 && ($keyword eq "closeudgr" || $keyword eq "closeustr")) {
      log_msg(LOG_ERR, "$keyword action is not supported on Win32");
      return INVALIDVALUE;
    }

    process_action_parens($file);

    if (!length($file)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty filename given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "closef") { return (CLOSEF, $file); }
    elsif ($keyword eq "closeudgr") { return (CLOSEUDGR, $file); }
    elsif ($keyword eq "closeustr") { return (CLOSEUSTR, $file); }
    else { return (DROPINPUT, $file); }
  }

  elsif ($action =~ /^(udpsock|tcpsock)\s+(\S+)(?:\s+(.*\S))?$/i) {

    $keyword = lc($1);
    $peer = $2;
    $event = defined($3)?$3:"";

    process_action_parens($peer, $event);

    if (!length($peer)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty peername given for $keyword action");
      return INVALIDVALUE;
    }

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

    if ($keyword eq "udpsock") { return (UDPSOCK, $peer, $event); }
    else { return (TCPSOCK, $peer, $event); }
  }

  elsif ($action =~ /^(closeudp|closetcp)\s+(\S+)$/i) {

    $keyword = lc($1);
    $peer = $2;

    process_action_parens($peer);

    if (!length($peer)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty peername given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "closeudp") { return (CLOSEUDP, $peer); }
    else { return (CLOSETCP, $peer); }
  }

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

    $keyword = lc($1);
    $cmdline = $2;
    process_action_parens($cmdline);

    if (!length($cmdline)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty commandline given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "shellcmd") { return (SHELLCOMMAND, $cmdline); }
    else { return (COMMANDEXEC, [ split(' ', $cmdline) ]); }
  }

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

    $keyword = lc($1);
    $cmdline = $2;

    if ($WIN32) {
      log_msg(LOG_ERR, "$keyword action is not supported on Win32");
      return INVALIDVALUE;
    }

    process_action_parens($cmdline);

    if (!length($cmdline)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty commandline given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "spawn") { return (SPAWN, $cmdline); }
    else { return (SPAWNEXEC, [ split(' ', $cmdline) ]); }
  }

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

    $keyword = lc($1);
    $context = $2;
    $cmdline = $3;

    if ($WIN32) {
      log_msg(LOG_ERR, "$keyword action is not supported on Win32");
      return INVALIDVALUE;
    }

    process_action_parens($context, $cmdline);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for $keyword action");
      return INVALIDVALUE;
    }

    if (!length($cmdline)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty commandline given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "cspawn") { return (CSPAWN, $context, $cmdline); }
    else { return (CSPAWNEXEC, $context, [ split(' ', $cmdline) ]); }
  }

  elsif ($action =~ /^(pipe|pipeexec)\s+'([^']*)'(?:\s+(.*\S))?$/i) {

    $keyword = lc($1);
    $event = $2;
    $cmdline = defined($3)?$3:"";

    process_action_parens($event, $cmdline);

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

    # note that if commandline is not provided, $cmdline is set to
    # empty string, and in this case split() produces an empty list

    if ($keyword eq "pipe") { return (PIPE, $event, $cmdline); }
    else { return (PIPEEXEC, $event, [ split(' ', $cmdline) ]); }
  }

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

    $context = defined($1)?$1:"";
    $lifetime = defined($2)?$2:"";
    $actionlist = defined($3)?$3:"";

    process_action_parens($context, $lifetime);

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

    if (!length($context))  { $context = "%s"; }
    if (!length($lifetime))  { $lifetime = 0; }

    if (length($actionlist)) {
      if (!analyze_actionlist($actionlist, \@action,
          $conffile, $lineno, $ruleid))  { return INVALIDVALUE; }
      return (CREATECONTEXT, $context, $lifetime, [ @action ]);
    }

    return (CREATECONTEXT, $context, $lifetime, []);
  }

  elsif ($action =~ /^(delete|obsolete|unalias)(?:\s+(\S+))?$/i) {

    $keyword = lc($1);
    $context = defined($2)?$2:"";
    process_action_parens($context);
    if (!length($context))  { $context = "%s"; }

    if ($keyword eq "delete") { return (DELETECONTEXT, $context); }
    elsif ($keyword eq "obsolete") { return (OBSOLETECONTEXT, $context); }
    else { return (UNALIAS, $context); }
  }

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

    $context = $1;
    $lifetime = $2;
    $actionlist = defined($3)?$3:"";

    process_action_parens($context, $lifetime);

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

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for set action");
      return INVALIDVALUE;
    }

    if (!length($lifetime)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty lifetime given for set action");
      return INVALIDVALUE;
    }

    if (length($actionlist)) {
      if (!analyze_actionlist($actionlist, \@action,
          $conffile, $lineno, $ruleid))  { return INVALIDVALUE; }
      return (SETCONTEXT, $context, $lifetime, [ @action ]);
    }

    return (SETCONTEXT, $context, $lifetime, []);
  }

  elsif ($action =~ /^alias\s+(\S+)(?:\s+(\S+))?$/i) {

    $context = $1;
    $alias = defined($2)?$2:"";
    process_action_parens($context, $alias);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for alias action");
      return INVALIDVALUE;
    }

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

    return (ALIAS, $context, $alias);
  }

  elsif ($action =~ /^(add|prepend|fill)\s+(\S+)(?:\s+(.*\S))?$/i) {

    $keyword = lc($1);
    $context = $2;
    $event = defined($3)?$3:"";
    process_action_parens($context, $event);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for $keyword action");
      return INVALIDVALUE;
    }

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

    if ($keyword eq "add") { return (ADD, $context, $event); }
    elsif ($keyword eq "prepend") { return (PREPEND, $context, $event); }
    else { return (FILL, $context, $event); }
  }

  elsif ($action =~ /^(report|reportexec)\s+(\S+)(?:\s+(.*\S))?$/i) {

    $keyword = lc($1);
    $context = $2;
    $cmdline = defined($3)?$3:"";

    process_action_parens($context, $cmdline);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for $keyword action");
      return INVALIDVALUE;
    }

    # note that if commandline is not provided, $cmdline is set to
    # empty string, and in this case split() produces an empty list

    if ($keyword eq "report") { return (REPORT, $context, $cmdline); }
    else { return (REPORTEXEC, $context, [ split(' ', $cmdline) ]); }
  }

  elsif ($action =~ /^(copy|pop|shift)\s+(\S+)\s+(\S+)$/i) {

    $keyword = lc($1);
    $context = $2;
    $variable = $3;
    process_action_parens($context);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for $keyword action");
      return INVALIDVALUE;
    }

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if ($keyword eq "copy") {
      return (COPYCONTEXT, $context, substr($variable, 1));
    } elsif ($keyword eq "pop") {
      return (POP, $context, substr($variable, 1));
    } else { return (SHIFT, $context, substr($variable, 1)); }
  }

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

    $context = $1;
    $variable = defined($2)?$2:"";
    process_action_parens($context);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for empty action");
      return INVALIDVALUE;
    }

    if (length($variable)  &&  $variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

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

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

  elsif ($action =~ /^(exists|getsize|getaliases|getltime|getctime)\s+(\S+)\s+(\S+)$/i) {

    $keyword = lc($1);
    $variable = $2;
    $context = $3;
    process_action_parens($context);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for $keyword action");
      return INVALIDVALUE;
    }

    if ($keyword eq "exists") {
      return (EXISTS, substr($variable, 1), $context);
    } elsif ($keyword eq "getsize") {
      return (GETSIZE, substr($variable, 1), $context);
    } elsif ($keyword eq "getaliases") {
      return (GETALIASES, substr($variable, 1), $context);
    } elsif ($keyword eq "getltime") {
      return (GETLIFETIME, substr($variable, 1), $context);
    } else { return (GETCTIME, substr($variable, 1), $context); }
  }

  elsif ($action =~ /^setltime\s+(\S+)(?:\s+(\S+))?$/i) {

    $context = $1;
    $lifetime = defined($2)?$2:"";
    process_action_parens($context, $lifetime);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for setltime action");
      return INVALIDVALUE;
    }

    if (!length($lifetime))  { $lifetime = 0; }

    return (SETLIFETIME, $context, $lifetime);
  }

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

    $timestamp = $1;
    $context = $2;
    process_action_parens($timestamp, $context);

    if (!length($timestamp)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty timestamp given for setctime action");
      return INVALIDVALUE;
    }

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for setctime action");
      return INVALIDVALUE;
    }

    return (SETCTIME, $timestamp, $context);
  }

  elsif ($action =~ /^event(?:\s+0*([0-9]+))?(?:\s+(.*\S))?$/i) {

    $createafter = defined($1)?$1:"";
    $event = defined($2)?$2:"";
    process_action_parens($event);

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

    return (EVENT, $createafter, $event);
  }

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

    $createafter = $1;
    $event = defined($2)?$2:"";
    process_action_parens($createafter, $event);

    if (!length($createafter)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty time offset given for tevent action");
      return INVALIDVALUE;
    }

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

    return (TEVENT, $createafter, $event);
  }

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

    $context = $1;
    $createafter = $2;
    $event = defined($3)?$3:"";

    process_action_parens($context, $createafter, $event);

    if (!length($context)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty context name given for cevent action");
      return INVALIDVALUE;
    }

    if (!length($createafter)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty time offset given for cevent action");
      return INVALIDVALUE;
    }

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

    return (CEVENT, $context, $createafter, $event);
  }

  elsif ($action =~ /^reset(?:\s+([+-]?)0*([0-9]+))?(?:\s+(.*\S))?$/i) {

    $sign = defined($1)?$1:"";
    $rule = defined($2)?$2:"";
    $event = defined($3)?$3:"";

    process_action_parens($event);

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

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

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

  elsif ($action =~ /^getwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) {

    $variable = $1;
    $sign = $2;
    $rule = $3;
    $event = defined($4)?$4:"";

    process_action_parens($event);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

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

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

    return (GETWINPOS, substr($variable, 1), $conffile, $rule, $event);
  }

  elsif ($action =~ /^setwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) {

    $timestamp = $1;
    $sign = $2;
    $rule = $3;
    $event = defined($4)?$4:"";

    process_action_parens($timestamp, $event);

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

    if (!length($timestamp)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty timestamp given for setwpos action");
      return INVALIDVALUE;
    }

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

    return (SETWINPOS, $timestamp, $conffile, $rule, $event);
  }

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

    $keyword = lc($1);
    $variable = $2;
    $value = defined($3)?$3:"";
    process_action_parens($value);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

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

    if ($keyword eq "assign") {
      return (ASSIGN, substr($variable, 1), $value);
    } else { return (ASSIGNSQ, substr($variable, 1), $value); }
  }

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

    $variable = $1;

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    return (FREE, substr($variable, 1));
  }

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

    $variable = $1;
    $code = $2;
    process_action_parens($code);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

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

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

    $variable = $1;
    $codeptr = $2;
    $params = defined($3)?$3:"";

    process_action_parens($params);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if ($codeptr !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $codeptr does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    # note that if parameters are not provided, $params is set to
    # empty string, and in this case split() produces an empty list

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

  elsif ($action =~ /^lcall\s+(\S+)\s*(.*?)\s*(->|:>)\s*(.*\S)$/i) {

    $variable = $1;
    $params = $2;
    $op = $3 eq ":>";
    $code = $4;

    process_action_parens($params, $code);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    ($evalok, $codeptr) = SEC::call_eval($code, 0);

    if (!$evalok || !defined($codeptr) || ref($codeptr) ne "CODE") {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Eval '$code' didn't return a code reference:",
              defined($codeptr)?"$codeptr":"undef");
      return INVALIDVALUE;
    }

    # note that if parameters are not provided, $params is set to
    # empty string, and in this case split() produces an empty list

    return (LCALL, substr($variable, 1), $codeptr, [ split(' ', $params) ], $op);
  }

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

    $count = $1;
    $event = defined($2)?$2:"";
    process_action_parens($count, $event);

    if (!length($count)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty linecount given for rewrite action");
      return INVALIDVALUE;
    }

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

    return (REWRITE, $count, $event);
  }

  elsif ($action =~ /^addinput\s+(\S+)(?:\s+(\S+)(?:\s+(\S+))?)?$/i) {

    $file = $1;
    $fpos = defined($2)?$2:"";
    $context = defined($3)?$3:"";
    process_action_parens($file, $fpos, $context);

    if (!length($file)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty filename given for addinput action");
      return INVALIDVALUE;
    }

    if (!length($fpos))  { $fpos = "-"; }
    if (!length($context))  { $context = FILEVENT_INT_CONTEXT_PREF . $file; }

    return (ADDINPUT, $file, $fpos, $context);
  }

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

    $signal = $1;
    process_action_parens($signal);

    if (!length($signal)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty signal name given for sigemul action");
      return INVALIDVALUE;
    }

    return (SIGEMUL, $signal);
  }

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

    $variable = $1;
    $entry = $2;
    process_action_parens($entry);

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if (!length($entry)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Empty pattern match cache entry name given for varset action");
      return INVALIDVALUE;
    }

    return (VARIABLESET, substr($variable, 1), $entry);
  }

  elsif ($action =~ /^if\s/i) {

    $value = EXPRSYMBOL;

    if ($action2 =~ /^if\s+(\S+)\s+$value\s+else\s+$value$/i) {
      $variable = $1;
      $actionlist = $list->[0];
      $actionlist2 = $list->[1];
    } elsif ($action2 =~ /^if\s+(\S+)\s+$value$/i) {
      $variable = $1;
      $actionlist = $list->[0];
      $actionlist2 = "";
    } else { return INVALIDVALUE; }

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if ($actionlist =~ /^\s*$/) { @action = (); }
    elsif (!analyze_actionlist($actionlist, \@action,
           $conffile, $lineno, $ruleid))  { return INVALIDVALUE; }

    if ($actionlist2 =~ /^\s*$/) { @action2 = (); }
    elsif (!analyze_actionlist($actionlist2, \@action2,
           $conffile, $lineno, $ruleid))  { return INVALIDVALUE; }

    if (!scalar(@action) && !scalar(@action2)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "empty action lists given for if-else");
      return INVALIDVALUE;
    }

    return (IF, substr($variable, 1), [ @action ], [ @action2 ]);
  }

  elsif ($action =~ /^while\s/i) {

    $value = EXPRSYMBOL;

    if ($action2 =~ /^while\s+(\S+)\s+$value$/i) {
      $variable = $1;
      $actionlist = $list->[0];
    } else { return INVALIDVALUE; }

    if ($variable !~ /^%[[:alpha:]]\w*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "Variable $variable does not have the form",
                       "%<letter>[<letter>|<digit>|<underscore>]...");
      return INVALIDVALUE;
    }

    if ($actionlist =~ /^\s*$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                       "empty action list given for while");
      return INVALIDVALUE;
    }

    if (!analyze_actionlist($actionlist, \@action,
        $conffile, $lineno, $ruleid))  { return INVALIDVALUE; }

    return (WHILE, substr($variable, 1), [ @action ]);
  }

  elsif ($action =~ /^break$/i)  { return BREAK; }

  elsif ($action =~ /^continue$/i)  { return CONTINUE; }

  log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
          "Invalid action '$action'");
  return INVALIDVALUE;

}


# Parameters: par1 - action list separated by semicolons
#             par2 - reference to an array
#             par3 - the name of the configuration file
#             par4 - line number in configuration file
#             par5 - rule ID
# Action: par1 will be split to parts, each part is analyzed and saved
#         to array @{$par2}. Previous content of the array is erased.
#         Parameters par3..par5 will be passed to the analyze_action()
#         function for logging purposes. Return 0 if an invalid action
#         was detected in the list par1, otherwise return 1.

sub analyze_actionlist {

  my($actionlist, $arrayref, $conffile, $lineno, $ruleid) = @_;
  my(@parts, $part, $part2);
  my($actiontype, @action);
  my($newactionlist, @list, @list2, $expr);
  my($pos, $l);

  @{$arrayref} = ();

  # remove leading and trailing whitespace from actionlist
  if ($actionlist =~ /^\s*(.*?)\s*$/)  { $actionlist = $1; }

  # replace the actions that are in parentheses with special symbols
  # and save the actions to @list

  $newactionlist = replace_subexpr($actionlist, \@list);

  if (!defined($newactionlist)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Unbalanced parentheses found in action list '$actionlist'");
    return 0;
  }

  # split actionlist into parts by semicolon, removing
  # all whitespace before and after semicolons

  @parts = split(/\s*;\s*/, $newactionlist);

  $l = length(EXPRSYMBOL);

  foreach $part (@parts) {

    # substitute special symbols with expressions
    # that were removed previously

    $part2 = $part;
    @list2 = ();

    for (;;) {

      $pos = index($part, EXPRSYMBOL);
      if ($pos == -1)  { last; }

      $expr = shift @list;
      substr($part, $pos, $l) = "(" . $expr . ")";

      push @list2, $expr;
    }

    # analyze the action list part

    ($actiontype, @action) =
        analyze_action($part, $conffile, $lineno, $ruleid, $part2, \@list2);

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

    push @{$arrayref}, $actiontype, @action;

  }

  return 1;

}


# Parameters: par1 - context expression
#             par2 - reference to an array
# Action: par1 will be analyzed and saved to array par2 (it is assumed
#         that par1 does not contain expressions in parentheses). Previous
#         content of the array par2 is erased. If errors are found when
#         analyzing par1, 0 will be returned, otherwise 1 will be returned.

sub analyze_context_expr {

  my($context, $result) = @_;
  my($pos, $oper, $op1, $op2);
  my(@side1, @side2);
  my($evalok, $retval);

  # if we are parsing '&&' and '||' operators that take 2 operands,
  # process the context expression from the end with rindex(), in order
  # to get "from left to right" processing for AND and OR at runtime

  $pos = rindex($context, "||");

  if ($pos != -1) {

    $op1 = substr($context, 0, $pos);
    $op2 = substr($context, $pos + 2);

    if (!analyze_context_expr($op1, \@side1))  { return 0; }
    if (!analyze_context_expr($op2, \@side2))  { return 0; }

    @{$result} = ( @side1, @side2, OR );
    return 1;
  }

  $pos = rindex($context, "&&");

  if ($pos != -1) {

    $op1 = substr($context, 0, $pos);
    $op2 = substr($context, $pos + 2);

    if (!analyze_context_expr($op1, \@side1))  { return 0; }
    if (!analyze_context_expr($op2, \@side2))  { return 0; }

    @{$result} = ( @side1, @side2, AND );
    return 1;
  }

  # consider '!' operator a negation if it appears in front of the operand

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

    $op1 = $1;
    if (!analyze_context_expr($op1, \@side1))  { return 0; }

    @{$result} = ( @side1, NEGATION );
    return 1;
  }

  # since CCODE, ECODE and OPERAND are terminals, make sure that any
  # leading and trailing whitespace is removed from their parameters
  # (rest of the code relies on that); also, remove backslashes in front
  # of the parentheses

  if ($context =~ /^\s*(.*?)\s*(->|:>)\s*(.*\S)/) {

    $op1 = $1;
    $oper = $2;
    $op2 = $3;

    if ($op1 ne EXPRSYMBOL) {
      $op1 =~ s/\\([()])/$1/g;
      $op1 = [ split(' ', $op1) ];
    }

    if ($op2 ne EXPRSYMBOL) {

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

      ($evalok, $retval) = SEC::call_eval($op2, 0);

      if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
        log_msg(LOG_ERR, "Eval '$op2' didn't return a code reference:",
                         defined($retval)?"$retval":"undef");
        return 0;
      }

      $op2 = $retval;

    }

    if ($oper eq "->") { @{$result} = ( CCODE, $op1, $op2 ); }
      else { @{$result} = ( CCODE2, $op1, $op2 ); }

    return 1;
  }

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

    $op1 = $1;
    if ($op1 ne EXPRSYMBOL)  { $op1 =~ s/\\([()])/$1/g; }

    @{$result} = ( ECODE, $op1 );
    return 1;
  }

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

    $op1 = $1;
    if ($op1 ne EXPRSYMBOL)  { $op1 =~ s/\\([()])/$1/g; }

    @{$result} = ( VARSET, $op1 );
    return 1;
  }

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

    $op1 = $1;
    if ($op1 ne EXPRSYMBOL)  { $op1 =~ s/\\([()])/$1/g; }

    @{$result} = ( OPERAND, $op1 );
    return 1;
  }

  return 0;

}


# Parameters: par1 - context expression
#             par2 - reference to an array
# Action: par1 will be analyzed and saved to array par2. Previous content
#         of the array par2 is erased. If errors are found when analyzing
#         par1, 0 will be returned, otherwise 1 will be returned.

sub analyze_context {

  my($context, $result) = @_;
  my($newcontext, $i, $j);
  my($params, $code, $evalok, $retval);
  my($subexpr, @expr);

  # replace upper level expressions in parentheses with special symbol
  # and save the expressions to @expr (i.e. !(a && (b || c )) || d
  # becomes !specialsymbol || d, and "a && (b || c )" is saved to @expr);
  # if context was not parsed successfully, exit

  $newcontext = replace_subexpr($context, \@expr);

  if (!defined($newcontext))  { return 0; }

  # convert context expression to internal format, and if no parenthesized
  # subexpressions were found in the expression during previous step, exit

  if (!analyze_context_expr($newcontext, $result))  { return 0; }

  if ($newcontext eq $context)  { return 1; }

  # If the expression contains parenthesized subexpressions, analyze and
  # convert these expressions recursively, attaching the results to
  # the current expression. If a parenthesized subexpression is a Perl code,
  # it will not be analyzed recursively but rather treated as a terminal
  # (backslashes in front of the parentheses are removed). If not all
  # subexpressions are consumed during the analysis, they have been defined
  # in invalid locations (e.g., inside context names).

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

  while ($i < $j) {

    if ($result->[$i] == OPERAND) {

      if ($result->[$i+1] eq EXPRSYMBOL) {
        $result->[$i] = EXPRESSION;
        $result->[$i+1] = [];
        $subexpr = shift @expr;
        if (!analyze_context($subexpr, $result->[$i+1]))  { return 0; }
      }

      $i += 2;
    }

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

      if ($result->[$i+1] eq EXPRSYMBOL) {
        $code = shift @expr;
        $code =~ s/\\([()])/$1/g;
        $result->[$i+1] = $code;
      }

      $i += 2;
    }

    elsif ($result->[$i] == CCODE || $result->[$i] == CCODE2) {

      if ($result->[$i+1] eq EXPRSYMBOL) {
        $params = shift @expr;
        $params =~ s/\\([()])/$1/g;
        $result->[$i+1] = [ split(' ', $params) ];
      }

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

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

        ($evalok, $retval) = SEC::call_eval($code, 0);

        if (!$evalok || !defined($retval) || ref($retval) ne "CODE") {
          log_msg(LOG_ERR, "Eval '$code' didn't return a code reference:",
                           defined($retval)?$retval:"undef");
          return 0;
        }

        $result->[$i+2] = $retval;

      }

      $i += 3;
    }

    elsif ($result->[$i] == VARSET) {

      if ($result->[$i+1] eq EXPRSYMBOL) {
        $subexpr = shift @expr;
        $subexpr =~ s/\\([()])/$1/g;
        $result->[$i+1] = $subexpr;
      }

      $i += 2;
    }

    else { ++$i; }

  }

  if (scalar(@expr)) {
    foreach $subexpr (@expr) {
      log_msg(LOG_ERR, "Unexpected subexpression '$subexpr' in '$context'");
    }
    return 0;
  }

  return 1;

}


# Parameters: par1 - context expression
# Action: if par1 is surrounded by [] brackets, the brackets will be
#         removed and 1 will be returned, otherwise 0 will be returned.

sub check_context_preeval {

  if ($_[0] =~ /^\s*\[(.*)\]\s*$/) {
    $_[0] = $1;
    return 1;
  } else {
    return 0;
  }

}


# Parameters: par1 - list of the time values
#             par2 - minimum possible value for time
#             par3 - maximum possible value for time
#             par4 - offset that must be added to every list value
#             par5 - reference to a hash where every list value is added
# Action: take the list definition and find the time values that belong
#         to the list (list definition is given in crontab-style).
#         After the values have been calculated, add an element to par5 with
#         the key that equals to the calculated value + offset. Leading zeros
#         are removed from keys (rest of the code relies on that). E.g., if
#         offset is 0, then "02,5-07" becomes 2,5,6,7; if offset is -1, min
#         is 1, and max is 12, then "2,5-7,11-" becomes 1,4,5,6,10,11. Before
#         adding elements to par5, its previous content is erased. If par1 is
#         specified incorrectly, return value is 0, otherwise 1 is returned.

sub eval_timelist {

  my($spec, $min, $max, $offset, $ref) = @_;
  my(@parts, $part, $step);
  my($pos, $range1, $range2);
  my($i, $j);

  # split time specification into parts (by comma) and look what
  # ranges or individual numbers every part defines

  @parts = split(/,/, $spec);
  if (!scalar(@parts))  { return 0; }

  %{$ref} = ();

  foreach $part (@parts) {

    # if part is empty, skip it and take the next part

    if (!length($part))  { next; }

    # check if part has a valid step value (0 is illegal)

    if ($part =~ /^(.+)\/0*([0-9]+)$/) {
      $part = $1;
      $step = $2;
      if ($step == 0)  { return 0; }
    } else {
      $step = undef;
    }

    # if part equals to '*', assume that it defines the range min..max

    if ($part eq "*") {

      # add offset (this also forces numeric context, so "05" becomes "5")
      # and save values to the hash; if step was not defined, assume 1

      $i = $min + $offset;
      $j = $max + $offset;

      if (!defined($step))  { $step = 1; }

      while ($i <= $j) {
        $ref->{$i} = 1;
        $i += $step;
      }

      next;

    }

    # if part is not empty and not '*', check if it contains '-'

    $pos = index($part, "-");

    if ($pos == -1) {

      # if part does not contain '-', assume it defines a single number

      if ($part =~ /^0*([0-9]+)$/)  { $part = $1; }  else { return 0; }
      if ($part < $min  ||  $part > $max)  { return 0; }

      # step value is illegal for a single number

      if (defined($step))  { return 0; }

      # add offset and save value to the hash

      $part += $offset;
      $ref->{$part} = 1;

    } else {

      # if part does contain '-', assume it defines a range

      $range1 = substr($part, 0, $pos);
      $range2 = substr($part, $pos + 1);

      # if left side of the range is missing, assume minimum for the value;
      # if right side of the range is missing, assume maximum for the value;
      # offset is then added to the left and right side of the range

      if (length($range1)) {

        if ($range1 =~ /^0*([0-9]+)$/)  { $range1 = $1; }  else { return 0; }
        if ($range1 < $min  ||  $range1 > $max)  { return 0; }

        $i = $range1 + $offset;

      } else { $i = $min + $offset; }

      if (length($range2)) {

        if ($range2 =~ /^0*([0-9]+)$/)  { $range2 = $1; }  else { return 0; }
        if ($range2 < $min  ||  $range2 > $max)  { return 0; }

        $j = $range2 + $offset;

      } else { $j = $max + $offset; }

      # save values to the hash; if step was not defined, assume 1

      if (!defined($step))  { $step = 1; }

      while ($i <= $j) {
        $ref->{$i} = 1;
        $i += $step;
      }

    }

  }

  return 1;

}


# Parameters: par1 - time specification
#             par2..par7 - references to the hashes of minutes, hours,
#                          days, months, weekdays and years
#             par8 - the name of the configuration file
#             par9 - line number in configuration file
# Action: par1 will be split to parts, every part is analyzed and
#         results are saved into hashes par2..par6.
#         Previous content of the hashes is erased. If errors
#         are found when analyzing par1, 0 is returned, otherwise 1
#         will be return value.

sub analyze_timespec {

  my($timespec, $minref, $hourref, $dayref,
     $monthref, $wdayref, $yearref, $conffile, $lineno) = @_;
  my(@parts, $size);

  # split time specification into parts by whitespace (like with
  # split(/\s+/, ...)), but leading whitespace will be ignored

  @parts = split(' ', $timespec);
  $size = scalar(@parts);

  if ($size < 5 || $size > 6) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Wrong number of elements in time specification");
    return 0;
  }

  # if no year specification has been given, assume *
  if ($size == 5)  { push @parts, "*"; }

  # evaluate minute specification (range 0..59, offset 0)

  if (!eval_timelist($parts[0], 0, 59, 0, $minref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid minute specification '$parts[0]'");
    return 0;
  }

  # evaluate hour specification (range 0..23, offset 0)

  if (!eval_timelist($parts[1], 0, 23, 0, $hourref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid hour specification '$parts[1]'");
    return 0;
  }

  # evaluate day specification (range 0..31, offset 0)
  # 0 denotes the last day of a month

  if (!eval_timelist($parts[2], 0, 31, 0, $dayref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid day specification '$parts[2]'");
    return 0;
  }

  # evaluate month specification (range 1..12, offset -1)

  if (!eval_timelist($parts[3], 1, 12, -1, $monthref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid month specification '$parts[3]'");
    return 0;
  }

  # evaluate weekday specification (range 0..7, offset 0)

  if (!eval_timelist($parts[4], 0, 7, 0, $wdayref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid weekday specification '$parts[4]'");
    return 0;
  }

  # if 7 was specified as a weekday, also define 0,
  # since perl uses only 0 for Sunday

  if (exists($wdayref->{"7"}))  { $wdayref->{"0"} = 1; }

  # evaluate year specification (range 0..99, offset 0)

  if (!eval_timelist($parts[5], 0, 99, 0, $yearref)) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Invalid year specification '$parts[5]'");
    return 0;
  }

  return 1;

}


# Parameters: par1 - reference to a hash containing the rule
#             par2 - hash of required and optional keywords for the rule
#             par3 - the type of the rule
#             par4 - the name of the configuration file
#             par5 - line number in configuration file the rule begins at
# Action: check if all required keywords are present in the rule par1 and
#         all keywords are legal (i.e., present in hash par2).
#         Return 0 if keywords are OK, otherwise return 1.

sub missing_keywords {

  my($ref, $keyhash, $type, $conffile, $lineno) = @_;
  my($key, $error);

  $error = 0;

  # check if all required keywords are present in the rule

  while ($key = each %{$keyhash}) {
    if ($keyhash->{$key} && !exists($ref->{$key})) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Keyword '$key' missing (needed for $type rule)");
      $error = 1;
    }
  }

  # check if all rule keywords are legal

  while ($key = each %{$ref}) {
    if (!exists($keyhash->{$key})) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Keyword '$key' illegal (not allowed for $type rule)");
      $error = 1;
    }
  }

  return $error;

}


# Parameters: par1 - reference to a hash containing the rule
#             par2 - name of the configuration file
#             par3 - line number in configuration file the rule begins at
#             par4 - rule ID
# Action: check the rule par1 for correctness and save it to
#         global array $configuration{par2} if it is well-defined;
#         if the rule specified rule file options, save the options to
#         global array $config_options{par2} if the rule is well-defined.
#         For a correctly defined Options-rule return 2, for a correctly
#         defined regular rule return 1, for an invalid rule return 0

sub check_rule {

  my($ref, $conffile, $lineno, $number) = @_;
  my($type, $rule, %keywords);
  my($ncomp, $cfset, $evtnum, $i, $j);

  if (!exists($ref->{"type"})) {
    log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
            "Keyword 'type' missing");
    return 0;
  }

  $type = uc($ref->{"type"});

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

  if ($type eq "SINGLE") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SINGLE,
              "VarMap" => {},
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "SINGLEWITHSCRIPT") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "script" => 1, "shell" => 0,
                 "desc" => 1, "action" => 1, "action2" => 0);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SINGLE_W_SCRIPT,
              "VarMap" => {},
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "Action2" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (exists($ref->{"shell"})) {
      if (uc($ref->{"shell"}) eq "YES") {
        $rule->{"Script"} = $ref->{"script"};
      } elsif (uc($ref->{"shell"}) eq "NO") {
        $rule->{"Script"} = [ split(' ', $ref->{"script"}) ];
      } else {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid shell value '", $ref->{"shell"}, "'");
        return 0;
      }
    } else {
      $rule->{"Script"} = $ref->{"script"};
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (exists($ref->{"action2"})) {
      if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
                              $conffile, $lineno, $number)) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid action list '", $ref->{"action2"}, "'");
        return 0;
      }
      if (contains_matchvars($ref->{"action2"}, '$'))
        { $rule->{"ActVolat2"} = 1; }
    }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "SINGLEWITHSUPPRESS") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
                 "window" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SINGLE_W_SUPPRESS,
              "VarMap" => {},
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if ($ref->{"window"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid time window '", $ref->{"window"}, "'");
      return 0;
    } else { $rule->{"Window"} = $1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "PAIR") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
                 "continue2" => 0, "ptype2" => 1, "pattern2" => 1,
                 "varmap2" => 0, "context2" => 0, "desc2" => 1,
                 "action2" => 1, "window" => 0);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => PAIR,
              "VarMap" => {},
              "VarMap2" => {},
              "Context" => [],
              "Context2" => [],
              "Desc" => $ref->{"desc"},
              "Desc2" => $ref->{"desc2"},
              "Action" => [],
              "Action2" => [],
              "Operations" => {},
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    if (exists($ref->{"continue2"})) {
      ($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) =
        analyze_continue($ref->{"continue2"}, $conffile, $lineno);
      if ($rule->{"WhatNext2"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext2"} = DONTCONT;
      $rule->{"GotoRule2"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    ($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) =
      analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
                      $conffile, $lineno, $rule->{"PatType"});
    if ($rule->{"PatType2"} == INVALIDVALUE)  { return 0; }
    if (defined($ncomp))  { $rule->{"Pat2NotCompiled"} = 1; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"varmap2"})) {
      if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"},
           $rule->{"VarMap2"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (exists($ref->{"context2"})) {
      if (check_context_preeval($ref->{"context2"}))
        { $rule->{"ContPreEval2"} = 1; }
      if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context2"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context2"}, '$', '%'))
        { $rule->{"ContVolat2"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action2"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action2"}, '$', '%'))
      { $rule->{"ActVolat2"} = 1; }

    if (!exists($ref->{"window"})) { $rule->{"Window"} = 0; }
    elsif ($ref->{"window"} =~ /^0*([0-9]+)$/) { $rule->{"Window"} = $1; }
    else {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid time window '", $ref->{"window"}, "'");
      return 0;
    }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "PAIRWITHWINDOW") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
                 "continue2" => 0, "ptype2" => 1, "pattern2" => 1,
                 "varmap2" => 0, "context2" => 0, "desc2" => 1,
                 "action2" => 1, "window" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => PAIR_W_WINDOW,
              "VarMap" => {},
              "VarMap2" => {},
              "Context" => [],
              "Context2" => [],
              "Desc" => $ref->{"desc"},
              "Desc2" => $ref->{"desc2"},
              "Action" => [],
              "Action2" => [],
              "Operations" => {},
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    if (exists($ref->{"continue2"})) {
      ($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) =
        analyze_continue($ref->{"continue2"}, $conffile, $lineno);
      if ($rule->{"WhatNext2"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext2"} = DONTCONT;
      $rule->{"GotoRule2"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    ($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) =
      analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"},
                      $conffile, $lineno, $rule->{"PatType"});
    if ($rule->{"PatType2"} == INVALIDVALUE)  { return 0; }
    if (defined($ncomp))  { $rule->{"Pat2NotCompiled"} = 1; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"varmap2"})) {
      if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"},
           $rule->{"VarMap2"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (exists($ref->{"context2"})) {
      if (check_context_preeval($ref->{"context2"}))
        { $rule->{"ContPreEval2"} = 1; }
      if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context2"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context2"}, '$', '%'))
        { $rule->{"ContVolat2"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action2"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action2"}, '$', '%'))
      { $rule->{"ActVolat2"} = 1; }

    if ($ref->{"window"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid time window '", $ref->{"window"}, "'");
      return 0;
    } else { $rule->{"Window"} = $1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "SINGLEWITHTHRESHOLD") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
                 "action2" => 0, "window" => 1, "thresh" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SINGLE_W_THRESHOLD,
              "VarMap" => {},
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "Action2" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (exists($ref->{"action2"})) {
      if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
                              $conffile, $lineno, $number)) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid action list '", $ref->{"action2"}, "'");
        return 0;
      }
      if (contains_matchvars($ref->{"action2"}, '$'))
        { $rule->{"ActVolat2"} = 1; }
    }

    if ($ref->{"window"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid time window '", $ref->{"window"}, "'");
      return 0;
    } else { $rule->{"Window"} = $1; }

    if ($ref->{"thresh"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid threshold '", $ref->{"thresh"}, "'");
      return 0;
    } else { $rule->{"Threshold"} = $1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "SINGLEWITH2THRESHOLDS") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1,
                 "window" => 1, "thresh" => 1, "desc2" => 1, "action2" => 1,
                 "window2" => 1, "thresh2" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SINGLE_W_2_THRESHOLDS,
              "VarMap" => {},
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Desc2" => $ref->{"desc2"},
              "Action" => [],
              "Action2" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action2"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action2"}, '$'))
      { $rule->{"ActVolat2"} = 1; }

    if ($ref->{"window"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid 1st time window '", $ref->{"window"}, "'");
      return 0;
    } else { $rule->{"Window"} = $1; }

    if ($ref->{"window2"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid 2nd time window '", $ref->{"window2"}, "'");
      return 0;
    } else { $rule->{"Window2"} = $1; }

    if ($ref->{"thresh"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid 1st threshold '", $ref->{"thresh"}, "'");
      return 0;
    } else { $rule->{"Threshold"} = $1; }

    if ($ref->{"thresh2"} !~ /^0*([0-9]+)$/) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid 2nd threshold '", $ref->{"thresh2"}, "'");
      return 0;
    } else { $rule->{"Threshold2"} = $1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

  # ------------------------------------------------------------
  # EVENT_GROUP rule
  # ------------------------------------------------------------

  elsif ($type =~ /^EVENTGROUP(?:0*\B)?([0-9]*)$/) {

    $evtnum = length($1)?$1:1;

    if ($evtnum < 1) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
        "Invalid rule type $type (N must be at least 1 for EventGroupN rule)");
      return 0;
    }

    %keywords = ("type" => 1,  "desc" => 1, "action" => 1, "multact" => 0,
                 "init" => 0, "slide" => 0, "end" => 0, "window" => 1,
                 "egptype" => 0, "egpattern" => 0);

    for ($i = 0; $i < $evtnum; ++$i) {
      $j = ($i==0)?"":($i+1);
      $keywords{"continue$j"} = 0;
      $keywords{"ptype$j"} = 1;
      $keywords{"pattern$j"} = 1;
      $keywords{"varmap$j"} = 0;
      $keywords{"context$j"} = 0;
      $keywords{"count$j"} = 0;
      $keywords{"thresh$j"} = 0;
    }

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => EVENT_GROUP,
              "EventNumber" => $evtnum,
              "WhatNextList" => [],
              "GotoRuleList" => [],
              "PatTypeList" => [],
              "PatternList" => [],
              "PatLinesList" => [],
              "VarMapList" => [],
              "ContextList" => [],
              "ContPreEvalList" => {},
              "ContVolatList" => {},
              "CountActionList" => [],
              "CountActVolatList" => {},
              "ThresholdList" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "InitAction" => [],
              "SlideAction" => [],
              "EndAction" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    for ($i = 0; $i < $evtnum; ++$i) {

      $rule->{"VarMapList"}->[$i] = {};
      $rule->{"ContextList"}->[$i] = [];
      $rule->{"CountActionList"}->[$i] = [];

      $j = ($i==0)?"":($i+1);

      if (exists($ref->{"continue$j"})) {
        ($rule->{"WhatNextList"}->[$i], $rule->{"GotoRuleList"}->[$i]) =
          analyze_continue($ref->{"continue$j"}, $conffile, $lineno);
        if ($rule->{"WhatNextList"}->[$i] == INVALIDVALUE)  { return 0; }
      } else {
        $rule->{"WhatNextList"}->[$i] = DONTCONT;
        $rule->{"GotoRuleList"}->[$i] = undef;
      }

      ($rule->{"PatTypeList"}->[$i],
       $rule->{"PatLinesList"}->[$i],
       $rule->{"PatternList"}->[$i]) = analyze_pattern($ref->{"ptype$j"},
                                                       $ref->{"pattern$j"},
                                                       $conffile, $lineno);
      if ($rule->{"PatTypeList"}->[$i] == INVALIDVALUE)  { return 0; }

      if (exists($ref->{"varmap$j"})) {
        if (!analyze_varmap($rule->{"PatTypeList"}->[$i],
                            $ref->{"varmap$j"}, $rule->{"VarMapList"}->[$i],
                            $conffile, $lineno))  { return 0; }
      }

      if (exists($ref->{"context$j"})) {
        if (check_context_preeval($ref->{"context$j"}))
          { $rule->{"ContPreEvalList"}->{$i} = 1; }
        if (!analyze_context($ref->{"context$j"},
                             $rule->{"ContextList"}->[$i])) {
          log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                  "Invalid context expression '", $ref->{"context$j"}, "'");
          return 0;
        }
        if (volatile_context($rule->{"ContextList"}->[$i], '$'))
          { $rule->{"ContVolatList"}->{$i} = 1; }
      }

      if (exists($ref->{"count$j"})) {
        if (!analyze_actionlist($ref->{"count$j"},
                                $rule->{"CountActionList"}->[$i],
                                $conffile, $lineno, $number)) {
          log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                  "Invalid action list '", $ref->{"count$j"}, "'");
          return 0;
        }
        if (contains_matchvars($ref->{"count$j"}, '$'))
          { $rule->{"CountActVolatList"}->{$i} = 1; }
      }

      if (exists($ref->{"thresh$j"})) {
        if ($ref->{"thresh$j"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
          log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                  "Invalid threshold '", $ref->{"thresh$j"}, "'");
          return 0;
        } else { $rule->{"ThresholdList"}->[$i] = $1; }
      } else { $rule->{"ThresholdList"}->[$i] = 1; }

    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }
    if (contains_matchvars($ref->{"action"}, '$'))
      { $rule->{"ActVolat"} = 1; }

    if (exists($ref->{"init"})) {
      if (!analyze_actionlist($ref->{"init"}, $rule->{"InitAction"},
                              $conffile, $lineno, $number)) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid action list '", $ref->{"init"}, "'");
        return 0;
      }
      if (contains_matchvars($ref->{"init"}, '$'))
        { $rule->{"InitActVolat"} = 1; }
    }

    if (exists($ref->{"slide"})) {
      if (!analyze_actionlist($ref->{"slide"}, $rule->{"SlideAction"},
                              $conffile, $lineno, $number)) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid action list '", $ref->{"slide"}, "'");
        return 0;
      }
      if (contains_matchvars($ref->{"slide"}, '$'))
        { $rule->{"SlideActVolat"} = 1; }
    }

    if (exists($ref->{"end"})) {
      if (!analyze_actionlist($ref->{"end"}, $rule->{"EndAction"},
                              $conffile, $lineno, $number)) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid action list '", $ref->{"end"}, "'");
        return 0;
      }
      if (contains_matchvars($ref->{"end"}, '$'))
        { $rule->{"EndActVolat"} = 1; }
    }

    if ($ref->{"window"} !~ /^0*([0-9]+)$/  ||  $1 == 0) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid time window '", $ref->{"window"}, "'");
      return 0;
    } else { $rule->{"Window"} = $1; }

    if (exists($ref->{"multact"})) {
      if (uc($ref->{"multact"}) eq "YES")  { $rule->{"MultipleActions"} = 1; }
      elsif (uc($ref->{"multact"}) ne "NO") {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid multact value '", $ref->{"multact"}, "'");
        return 0;
      }
    }

    if (exists($ref->{"egptype"}) && !exists($ref->{"egpattern"}) ||
        !exists($ref->{"egptype"}) && exists($ref->{"egpattern"})) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Keywords 'egptype' and 'egpattern' must be used together");
      return 0;
    }

    if (exists($ref->{"egptype"}) && exists($ref->{"egpattern"})) {
      ($rule->{"EGrpPatType"}, $rule->{"EGrpPattern"}) =
        analyze_eventgroup_pattern($ref->{"egptype"}, $ref->{"egpattern"},
                                   $conffile, $lineno);
      if ($rule->{"EGrpPatType"} == INVALIDVALUE)  { return 0; }
    }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

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

  elsif ($type eq "SUPPRESS") {

    %keywords = ("type" => 1, "ptype" => 1, "pattern" => 1,
                 "varmap" => 0, "context" => 0, "desc" => 0);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => SUPPRESS,
              "VarMap" => {},
              "Context" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!exists($ref->{"desc"})) {
      if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR ||
          $rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) {
        $rule->{"Desc"} =
          "Suppress rule with pattern: " . $rule->{"Pattern"};
      } elsif ($rule->{"PatType"} == NREGEXP ||
               $rule->{"PatType"} == NSUBSTR ||
               $rule->{"PatType"} == NPERLFUNC ||
               $rule->{"PatType"} == NCACHED) {
        $rule->{"Desc"} =
          "Suppress rule with negative pattern: " . $rule->{"Pattern"};
      } else {
        $rule->{"Desc"} =
          "Suppress rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE");
      }
    } else { $rule->{"Desc"} = $ref->{"desc"}; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

  # ------------------------------------------------------------
  # CALENDAR rule
  # ------------------------------------------------------------

  elsif ($type eq "CALENDAR") {

    %keywords = ("type" => 1, "time" => 1, "context" => 0,
                 "desc" => 1, "action" => 1);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => CALENDAR,
              "Minutes" => {},
              "Hours" => {},
              "Days" => {},
              "Months" => {},
              "Weekdays" => {},
              "Years" => {},
              "LastActionMinute" => 0,
              "LastActionHour" => 0,
              "LastActionDay" => 0,
              "LastActionMonth" => 0,
              "LastActionYear" => 0,
              "Context" => [],
              "Desc" => $ref->{"desc"},
              "Action" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (!analyze_timespec($ref->{"time"},
                          $rule->{"Minutes"}, $rule->{"Hours"},
                          $rule->{"Days"}, $rule->{"Months"},
                          $rule->{"Weekdays"}, $rule->{"Years"},
                          $conffile, $lineno))  { return 0; }

    # since for Calendar rule []-operator has no meaning, remove outer
    # square brackets if they exist, and don't set the ContPreEval flag

    if (exists($ref->{"context"})) {
      check_context_preeval($ref->{"context"});
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
    }

    if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"},
                            $conffile, $lineno, $number)) {
      log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
              "Invalid action list '", $ref->{"action"}, "'");
      return 0;
    }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

  # ------------------------------------------------------------
  # JUMP rule
  # ------------------------------------------------------------

  elsif ($type eq "JUMP") {

    %keywords = ("type" => 1, "continue" => 0, "ptype" => 1,
                 "pattern" => 1, "varmap" => 0, "context" => 0,
                 "cfset" => 0, "constset" => 0, "desc" => 0);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    $rule = { "ID" => $number,
              "Type" => JUMP,
              "VarMap" => {},
              "Context" => [],
              "MatchCount" => 0,
              "EventCount" => 0,
              "CPUtime" => 0,
              "LineNo" => $lineno };

    if (exists($ref->{"continue"})) {
      ($rule->{"WhatNext"}, $rule->{"GotoRule"}) =
        analyze_continue($ref->{"continue"}, $conffile, $lineno);
      if ($rule->{"WhatNext"} == INVALIDVALUE)  { return 0; }
    } else {
      $rule->{"WhatNext"} = DONTCONT;
      $rule->{"GotoRule"} = undef;
    }

    ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) =
      analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno);
    if ($rule->{"PatType"} == INVALIDVALUE)  { return 0; }

    if (exists($ref->{"varmap"})) {
      if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"},
           $rule->{"VarMap"}, $conffile, $lineno))  { return 0; }
    }

    if (exists($ref->{"context"})) {
      if (check_context_preeval($ref->{"context"}))
        { $rule->{"ContPreEval"} = 1; }
      if (!analyze_context($ref->{"context"}, $rule->{"Context"})) {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid context expression '", $ref->{"context"}, "'");
        return 0;
      }
      if (volatile_context($rule->{"Context"}, '$'))
        { $rule->{"ContVolat"} = 1; }
    }

    if (!exists($ref->{"desc"})) {
      if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR ||
          $rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) {
        $rule->{"Desc"} =
          "Jump rule with pattern: " . $rule->{"Pattern"};
      } elsif ($rule->{"PatType"} == NREGEXP ||
               $rule->{"PatType"} == NSUBSTR ||
               $rule->{"PatType"} == NPERLFUNC ||
               $rule->{"PatType"} == NCACHED) {
        $rule->{"Desc"} =
          "Jump rule with negative pattern: " . $rule->{"Pattern"};
      } else {
        $rule->{"Desc"} =
          "Jump rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE");
      }
    } else { $rule->{"Desc"} = $ref->{"desc"}; }

    if (exists($ref->{"cfset"})) {
      $rule->{"CFSet"} = [ split(' ', $ref->{"cfset"}) ];
    }

    if (exists($ref->{"constset"})) {
      if (uc($ref->{"constset"}) eq "YES")  { $rule->{"ConstSet"} = 1; }
      elsif (uc($ref->{"constset"}) ne "NO") {
        log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
                "Invalid constset value '", $ref->{"constset"}, "'");
        return 0;
      }
    } else { $rule->{"ConstSet"} = 1; }

    $configuration{$conffile}->[$number] = $rule;

    return 1;

  }

  # ------------------------------------------------------------
  # OPTIONS rule
  # ------------------------------------------------------------

  elsif ($type eq "OPTIONS") {

    %keywords = ("type" => 1, "joincfset" => 0, "procallin" => 0);

    if (missing_keywords($ref, \%keywords, $type,
                         $conffile, $lineno))  { return 0; }

    # discard any previous Options rule

    $config_options{$conffile} = {};

    # parse and save the procallin value; assume default for invalid value

    if (exists($ref->{"procallin"})) {
      if (uc($ref->{"procallin"}) eq "NO") {
        $config_options{$conffile}->{"JumpOnly"} = 1;
      } elsif (uc($ref->{"procallin"}) ne "YES") {
        log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
                          "Invalid procallin value '", $ref->{"procallin"},
                          "', assuming procallin=Yes");
      }
    }

    # parse and save the list of set names

    if (exists($ref->{"joincfset"})) {
      $config_options{$conffile}->{"CFSet"} = {};
      foreach $cfset (split(' ', $ref->{"joincfset"})) {
        $config_options{$conffile}->{"CFSet"}->{$cfset} = 1;
      }
    }

    return 2;

  }

  # ------------------------------------------------------------
  # end of rule processing
  # ------------------------------------------------------------

  log_msg(LOG_ERR, "Rule in $conffile at line $lineno:",
          "Invalid rule type $type");
  return 0;

}


# Parameters: par1 - name of the configuration file
#             par2 - reference to the hash of label->rule conversion
# Action: process continue-statements of rules of configuration file par1,
#         and resolve labels in 'continue=GoTo <label>' directives to rule
#         numbers. The numbers are stored into memory-based representation
#         of rules. Note that 'continue=TakeNext' is treated as
#         'continue=GoTo <nextrule>' (i.e., the number of the next rule is
#         stored). Also note that 'continue=DontCont' is treated as
#         'continue=GoTo <lastrule+1>', and 'continue=EndMatch' as
#         'continue=GoTo -1'. Although Suppress rule doesn't support
#         continue-statement, internally 'continue=GoTo <lastrule+1>' is used
#         for simplifying the rule processing at run time.

sub resolve_labels {

  my($conffile, $label2rule) = @_;
  my($i, $j, $k, $n);
  my($ref, $label, $id, $lineno);

  $n = scalar(@{$configuration{$conffile}});

  for ($i = 0; $i < $n; ++$i) {

    $ref = $configuration{$conffile}->[$i];

    if ($ref->{"Type"} == SUPPRESS)  { $ref->{"GotoRule"} = $n; }

    elsif (exists($ref->{"WhatNextList"})) {

      for ($j = 0; $j < $ref->{"EventNumber"}; ++$j) {

        if ($ref->{"WhatNextList"}->[$j] == GOTO) {

          $label = $ref->{"GotoRuleList"}->[$j];
          $lineno = $ref->{"LineNo"};
          $k = ($j==0)?"":($j+1);

          if (exists($label2rule->{$label})) {

            $id = $label2rule->{$label};
            if ($id <= $i) {
              log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "can't go backwards to label $label, assuming continue$k=DontCont");
              $ref->{"WhatNextList"}->[$j] = DONTCONT;
              $ref->{"GotoRuleList"}->[$j] = $n;
            } else { $ref->{"GotoRuleList"}->[$j] = $id; }

          } else {
            log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "label $label does not exist, assuming continue$k=DontCont");
            $ref->{"WhatNextList"}->[$j] = DONTCONT;
            $ref->{"GotoRuleList"}->[$j] = $n;
          }

        } elsif ($ref->{"WhatNextList"}->[$j] == TAKENEXT) {
          $ref->{"GotoRuleList"}->[$j] = $i + 1;
        } elsif ($ref->{"WhatNextList"}->[$j] == DONTCONT) {
          $ref->{"GotoRuleList"}->[$j] = $n;
        } elsif ($ref->{"WhatNextList"}->[$j] == ENDMATCH) {
          $ref->{"GotoRuleList"}->[$j] = -1;
        }

      }
    }

    else {

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

        if ($ref->{"WhatNext"} == GOTO) {

          $label = $ref->{"GotoRule"};
          $lineno = $ref->{"LineNo"};

          if (exists($label2rule->{$label})) {

            $id = $label2rule->{$label};
            if ($id <= $i) {
              log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "can't go backwards to label $label, assuming continue=DontCont");
              $ref->{"WhatNext"} = DONTCONT;
              $ref->{"GotoRule"} = $n;
            } else { $ref->{"GotoRule"} = $id; }

          } else {
            log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "label $label does not exist, assuming continue=DontCont");
            $ref->{"WhatNext"} = DONTCONT;
            $ref->{"GotoRule"} = $n;
          }

        } elsif ($ref->{"WhatNext"} == TAKENEXT) {
          $ref->{"GotoRule"} = $i + 1;
        } elsif ($ref->{"WhatNext"} == DONTCONT) {
          $ref->{"GotoRule"} = $n;
        } elsif ($ref->{"WhatNext"} == ENDMATCH) {
          $ref->{"GotoRule"} = -1;
        }
      }

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

        if ($ref->{"WhatNext2"} == GOTO) {

          $label = $ref->{"GotoRule2"};
          $lineno = $ref->{"LineNo"};

          if (exists($label2rule->{$label})) {

            $id = $label2rule->{$label};
            if ($id <= $i) {
              log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "can't go backwards to label $label, assuming continue2=DontCont");
              $ref->{"WhatNext2"} = DONTCONT;
              $ref->{"GotoRule2"} = $n;
            } else { $ref->{"GotoRule2"} = $id; }

          } else {
            log_msg(LOG_WARN, "Rule in $conffile at line $lineno:",
              "label $label does not exist, assuming continue2=DontCont");
            $ref->{"WhatNext2"} = DONTCONT;
            $ref->{"GotoRule2"} = $n;
          }

        } elsif ($ref->{"WhatNext2"} == TAKENEXT) {
          $ref->{"GotoRule2"} = $i + 1;
        } elsif ($ref->{"WhatNext2"} == DONTCONT) {
          $ref->{"GotoRule2"} = $n;
        } elsif ($ref->{"WhatNext2"} == ENDMATCH) {
          $ref->{"GotoRule2"} = -1;
        }
      }

    }
  }
}


# Parameters: par1 - name of the configuration file
# Action: read in rules from configuration file par1, so that leading
#         and trailing whitespace is removed both from keywords and values
#         of rule definions, and then call check_rule() for every rule.
#         if all rules in the file are correctly  defined, return 1,
#         otherwise return 0

sub read_configfile {

  my($conffile) = $_[0];
  my($fh, $linebuf, $line, $i, $cont, $rulestart);
  my($keyword, $value, $ret, $file_status);
  my(%rule, %label2rule);

  $file_status = 1;   # start with the assumption that all rules
                      # are correctly defined

  log_msg(LOG_NOTICE, "Reading configuration from $conffile");

  if (!open($fh, $conffile)) {
    log_msg(LOG_ERR, "Can't open configuration file $conffile ($!)");
    return 0;
  }

  $i = 0;
  $cont = 0;
  %rule = ();
  $rulestart = 1;
  %label2rule = ();

  for (;;) {

    # read next line from file

    $linebuf = <$fh>;

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

    if (defined($linebuf)) {

      chomp($linebuf);

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

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

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

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

      if (substr($line, length($line) - 1) eq '\\') {
        chop($line);
        $cont = 1;
        next;
      } else {
        $cont = 0;
      }

    }

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

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

      if (scalar(%rule)) {
        $ret = check_rule(\%rule, $conffile, $rulestart, $i);
        if ($ret == 1) { ++$i; }
        elsif ($ret == 0) { $file_status = 0; }
        %rule = ();
      }

      $rulestart = $. + 1;

      if (defined($linebuf))  { next; }  else { last; }

    }

    # split line into keyword and value

    if ($line =~ /^\s*([[:alnum:]]+)\s*=\s*(.*\S)/) {
      $keyword = $1;
      $value = $2;
    } else {
      log_msg(LOG_ERR, "$conffile line $. ($line):",
              "Line not in keyword=value format or non-alphanumeric keyword");
      $file_status = 0;
      next;
    }

    # if the keyword is "label", save the number of currently unfinished
    # or upcoming rule definition to the hash %label2rule;
    # if the keyword is "rem", ignore it as a comment;
    # otherwise save the keyword and value to the hash %rule

    if ($keyword eq "label") { $label2rule{$value} = $i; }
    elsif ($keyword ne "rem") {
      if (exists($rule{$keyword})) {
        log_msg(LOG_WARN, "Several '$keyword' keywords specified,",
                "overriding previous value '$rule{$keyword}' with '$value'");
      }
      $rule{$keyword} = $value;
    }

  }

  # if valid rules were loaded, resolve 'continue=GoTo' labels

  if ($i) {
    resolve_labels($conffile, \%label2rule);
    log_msg(LOG_DEBUG, "$i rules loaded from $conffile");
  } else {
    log_msg(LOG_WARN, "No valid rules found in configuration file $conffile");
  }

  close($fh);

  return $file_status;

}


# Parameters: -
# Action: evaluate the conffile patterns given in commandline, form the
#         list of configuration files and save it to global array
#         @conffiles, and read in rules from the configuration files;
#         also, create other global arrays for managing configuration

sub read_config {

  my($pattern, $conffile, $ret, $cfset);
  my(@stat, @rules, @files, %uniq);

  # Set the $lastconfigload variable to reflect the current time

  $lastconfigload = time();

  # Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
  # %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles.
  # The @conffiles array holds the names of _all_ configuration files;
  # the members of @conffiles act as keys for the %configuration,
  # %config_ltimes, %config_mtimes  and %config_options global hashes.
  # The %cfset2cfile hash creates a mapping between config fileset names
  # and file names - for each set name there is a file name list.
  # The files with rules accepting all input are stored to @mainfiles.

  %configuration = ();
  %config_ltimes = ();
  %config_mtimes = ();
  %config_options = ();

  @calendar = ();
  @conffiles = ();

  %cfset2cfile = ();
  @maincfiles = ();

  # Form the list of configuration files and save it to @conffiles;
  # repeated occurrences of the same file are discarded from the list

  @files = ();
  foreach $pattern (@conffilepat)  { push @files, glob($pattern); }

  %uniq = ();
  @conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files);

  # Read the configuration from rule files and store it to the global
  # array %configuration; also, store mtimes and options of rule files to
  # the global arrays %config_mtimes and %config_options; save Calendar
  # rules to the global array Calendar and set the %cfset2cfile hash

  $ret = 1;

  foreach $conffile (@conffiles) {

    $configuration{$conffile} = [];
    $config_ltimes{$conffile} = $lastconfigload;

    @stat = stat($conffile);
    $config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0;

    $config_options{$conffile} = {};

    if (!read_configfile($conffile))  { $ret = 0; }

    @rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
    push @calendar, @rules;

    if (exists($config_options{$conffile}->{"CFSet"})) {
      while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) {
        if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; }
        push @{$cfset2cfile{$cfset}}, $conffile;
      }
    }

  }

  # Create the @maincfiles array - it holds the names of configuration
  # files that accept input from all sources, not from Jump rules only

  @maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles);

  return $ret;

}


# Parameters: par1 - reference to an array where the names of modified
#                    and removed configuration files will be stored
# Action: evaluate the conffile patterns given in commandline, form the
#         list of configuration files and save it to global array
#         @conffiles; read in rules from the configuration files that are
#         either new or have been modified since the last configuration
#         load; also, create other global arrays for managing configuration.
#         As its output, the function stores to the array par1 the names
#         of configuration files that have been modified or removed since
#         the last configuration load.

sub soft_read_config {

  my($file_list) = $_[0];
  my($pattern, $conffile, $cfset);
  my(%old_config, %old_ltimes, %old_mtimes, %old_options);
  my(@old_conffiles, @stat, @rules, @files, %uniq);

  # Back up global arrays %configuration, %config_ltimes, %config_mtimes,
  # and @conffiles

  %old_config = %configuration;
  %old_ltimes = %config_ltimes;
  %old_mtimes = %config_mtimes;
  %old_options = %config_options;

  @old_conffiles = @conffiles;

  # Set the $lastconfigload variable to reflect the current time

  $lastconfigload = time();

  # Initialize global arrays %configuration, %config_ltimes, %config_mtimes,
  # %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles.
  # The @conffiles array holds the names of _all_ configuration files;
  # the members of @conffiles act as keys for the %configuration,
  # %config_ltimes, %config_mtimes  and %config_options global hashes.
  # The %cfset2cfile hash creates a mapping between config fileset names
  # and file names - for each set name there is a file name list.
  # The files with rules accepting all input are stored to @mainfiles.

  %configuration = ();
  %config_ltimes = ();
  %config_mtimes = ();
  %config_options = ();

  @calendar = ();
  @conffiles = ();

  %cfset2cfile = ();
  @maincfiles = ();

  # Form the list of configuration files and save it to @conffiles;
  # repeated occurrences of the same file are discarded from the list

  @files = ();
  foreach $pattern (@conffilepat)  { push @files, glob($pattern); }

  %uniq = ();
  @conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files);

  # Read the configuration from rule files that are new or have been
  # modified and store it to the global array %configuration; store mtimes
  # and options of rule files to the global arrays %config_mtimes and
  # %config_options; save Calendar rules to the global array Calendar and
  # set the %cfset2cfile hash.
  # Also, store the names of modified configuration files to the array par1

  @{$file_list} = ();

  foreach $conffile (@conffiles) {

    @stat = stat($conffile);
    $config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0;

    if (!exists($old_config{$conffile})) {

      $configuration{$conffile} = [];
      $config_options{$conffile} = {};
      read_configfile($conffile);
      $config_ltimes{$conffile} = $lastconfigload;

    } elsif ($old_mtimes{$conffile} != $config_mtimes{$conffile}) {

      $configuration{$conffile} = [];
      $config_options{$conffile} = {};
      read_configfile($conffile);
      $config_ltimes{$conffile} = $lastconfigload;

      push @{$file_list}, $conffile;

    } else {

      $configuration{$conffile} = $old_config{$conffile};
      $config_options{$conffile} = $old_options{$conffile};
      $config_ltimes{$conffile} = $old_ltimes{$conffile};

    }

    @rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}});
    push @calendar, @rules;

    if (exists($config_options{$conffile}->{"CFSet"})) {
      while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) {
        if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; }
        push @{$cfset2cfile{$cfset}}, $conffile;
      }
    }

  }

  # Create the @maincfiles array - it holds the names of configuration
  # files that accept input from all sources, not from Jump rules only

  @maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles);

  # Store the names of removed configuration files to the array par1

  push @{$file_list}, grep(!exists($configuration{$_}), @old_conffiles);

}


################################################
# Functions related to execution of action lists
################################################


# Parameters: -
# Action: set special action list variables for special characters

sub set_actionlist_char_var {

  my($i);

  # setting %% variable to % ensures that all occurrences of %% are
  # substituted with %

  $variables{"%"} = "%";

  # set other action list variables for various special characters

  $variables{".nl"} = "\n";
  $variables{".cr"} = "\r";
  $variables{".tab"} = "\t";
  $variables{".sp"} = " ";

  for ($i = 0; $i < 32; ++$i) { $variables{".chr$i"} = chr($i); }

}


# Parameters: par1 - timestamp (seconds since Epoch)
# Action: set special action list variables for timestamp par1

sub set_actionlist_time_var {

  my(@ltime) = localtime($_[0]);

  $variables{".sec"} = ($ltime[0] < 10)?("0" . $ltime[0]):$ltime[0];

  $variables{".min"} = ($ltime[1] < 10)?("0" . $ltime[1]):$ltime[1];

  $variables{".hour"} = ($ltime[2] < 10)?("0" . $ltime[2]):$ltime[2];

  $variables{".hmsstr"} = $variables{".hour"} . ":" . $variables{".min"}
                                              . ":" . $variables{".sec"};

  if ($ltime[3] < 10) {
    $variables{".mday"} = "0" . $ltime[3];
    $variables{".mdaystr"} = " " . $ltime[3];
  } else {
    $variables{".mday"} = $ltime[3];
    $variables{".mdaystr"} = $ltime[3];
  }

  $variables{".mon"} = ($ltime[4] < 9)?("0" . ($ltime[4]+1)):$ltime[4]+1;

  $variables{".monstr"} = POSIX::strftime("%b", @ltime);

  $variables{".year"} = $ltime[5] + 1900;

  $variables{".wday"} = $ltime[6];

  $variables{".wdaystr"} = POSIX::strftime("%a", @ltime);

  $variables{".tzname"} = POSIX::strftime("%Z", @ltime);

  $variables{".tzoff"} = POSIX::strftime("%z", @ltime);

  if ($variables{".tzoff"} =~ /^([+-][0-9]{2})([0-9]{2})$/) {
    $variables{".tzoff2"} = "$1:$2";
  } else {
    $variables{".tzoff2"} = "";
  }

}


# Parameters: par1 - string
#             par2 - string
# Action: all action list variables in string par1 will be replaced with
#         their values; string par2 will be assigned to special variable %s

sub substitute_actionlist_var {

  if (index($_[0], "%") == -1)  { return; }

  my($time) = time();

  # if builtin time-based action list variables do not reflect the current
  # second, set these variables to proper values

  if ($time != $timevar_update) {
    set_actionlist_time_var($time);
    $timevar_update = $time;
  }

  # since %u and %t variables can be modified from actions (e.g., 'assign'),
  # they are set to proper values before each substitution

  $variables{"u"} = $time;
  $variables{"t"} = localtime($time);

  # set %s variable to operation description string (second parameter)

  $variables{"s"} = $_[1];

  # substitute all action list variables

  $_[0] =~ s/%(?:(\.?[[:alpha:]]\w*|%)|\{(\.?[[:alpha:]]\w*)\})/
              defined($variables{$+})?$variables{$+}:""/egx;

}


# Parameters: par1 - commandline
#             par2 - 'collect output' flag
#             par3 - context
# Action: commandline par1 is executed with perl exec() in a child process.
#         If par1 is a reference to an array, commandline in array is
#         executed without shell interpretation; otherwise commandline is
#         interpreted with shell if it contains shell metacharacters.
#         The function creates an entry in the %children hash for the child
#         process and returns its pid. If process creation failed, undef is
#         returned. If par2 is defined and non-zero, standard output of the
#         commandline is returned to the main process through a pipe. If par3
#         is also defined, commandline's standard output is returned with an
#         internal context par3 (otherwise default internal context is used).

sub exec_cmd {

  my($cmdline, $collect_output, $context) = @_;
  my($cmd, $shell, $pid, $read, $write);

  # if the commandline has been provided as a reference to an array,
  # configure its execution without shell interpretation; also, set
  # $cmd variable to the entire commandline string

  if (ref($cmdline) eq "ARRAY") {
    $cmd = join(" ", @{$cmdline});
    $shell = 0;
  } else {
    $cmd = $cmdline;
    $shell = 1;
  }

  # set up a pipe before calling fork()

  if ($collect_output && !pipe($read, $write)) {
    log_msg(LOG_ERR, "Could not create pipe for command '$cmd' ($!)");
    return undef;
  }

  # try to create a child process and return undef, if fork failed;
  # if fork was successful and we are in parent process, return the
  # pid of the child process

  $pid = fork();

  if (!defined($pid)) {

    if ($collect_output) {
      close($read);
      close($write);
    }

    log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)");
    return undef;

  } elsif ($pid) {

    $children{$pid} = { "cmd" => $cmd,
                        "fh" => undef,
                        "open" => 0,
                        "buffer" => "",
                        "Desc" => undef,
                        "Action" => undef,
                        "Action2" => undef };

    if ($collect_output) {
      close($write);
      $children{$pid}->{"fh"} = $read;
      $children{$pid}->{"open"} = 1;
      $children{$pid}->{"context"} =
        defined($context)?$context:SYNEVENT_INT_CONTEXT;
    }

    log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'");
    return $pid;

  }

  # we are in the child process now...

  if ($collect_output) {

    # close the read end of the pipe and connect the standard output of
    # the child process to the write end of the pipe

    close($read);
    if (!open(STDOUT, ">&", $write))  { exit(1); }
    close($write);
  }

  # set SIGPIPE handling back to default before calling exec() (SIGPIPE is
  # ignored and exec() will only reset custom signal handlers to default)

  $SIG{PIPE} = 'DEFAULT';

  # set SIGTERM handling back to default (terminate) before calling exec();
  # if this process has received SIGTERM before default handling became
  # active, terminate the process without calling exec()

  $SIG{TERM} = 'DEFAULT';

  if (exists($terminate{$$}))  { exit(0); }

  # execute commandline - by default exec() keeps file descriptors 0..2 open
  # and closes other descriptors (see $^F special variable in perl docs);
  # if commandline must be executed without shell interpretation, call
  # exec() with list of commandline arguments and provide the first element
  # of the list as indirect object { $cmdline->[0] } (that disables shell
  # interpretation even if list has one element)

  if ($shell) {
    exec($cmdline);
  } else {
    exec { $cmdline->[0] } @{$cmdline};
  }

  exit(1);

}


# Parameters: par1 - commandline
#             par2 - reference to a hash or an array
# Action: this function creates two processes for executing commandline par1.
#         The child process writes the contents of array par2 (or keys of hash
#         par2) to the standard input of the commandline through a pipe.
#         Writing is synchronous (blocking) and hence the need for a separate
#         process. The grandchild has its standard input connected to the read
#         end of the pipe and executes the commandline with perl exec().
#         If par1 is a reference to an array, commandline in array is
#         executed without shell interpretation; otherwise commandline is
#         interpreted with shell if it contains shell metacharacters.
#         The function creates an entry in the %children hash for the child
#         process and returns its pid. If child process creation failed, undef
#         is returned. After the commandline has completed, the child process
#         terminates and returns grandchild exit code for its own exit value.

sub pipe_cmd {

  my($cmdline, $ref) = @_;
  my($cmd, $shell, $pid, $read, $write, $elem, $p);

  # if the commandline has been provided as a reference to an array,
  # configure its execution without shell interpretation; also, set
  # $cmd variable to the entire commandline string

  if (ref($cmdline) eq "ARRAY") {
    $cmd = join(" ", @{$cmdline});
    $shell = 0;
  } else {
    $cmd = $cmdline;
    $shell = 1;
  }

  # try to create a child process and return undef, if fork failed;
  # if fork was successful and we are in parent process, return the
  # pid of the child process

  $pid = fork();

  if (!defined($pid)) {

    log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)");
    return undef;

  } elsif ($pid) {

    $children{$pid} = { "cmd" => $cmd,
                        "fh" => undef,
                        "open" => 0,
                        "buffer" => "",
                        "Desc" => undef,
                        "Action" => undef,
                        "Action2" => undef };

    log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'");
    return $pid;

  }

  # we are in the child process now...
  # create a pipe for communicating with the commandline

  if (!pipe($read, $write))  { exit(1); }

  # Fork a process for commandline with pipe connected to its standard input.
  # open(pipe, "| cmd") with blocking close(pipe) that returns child exit code
  # are not used - if SIGTERM interrupts blocking close(pipe) and triggers
  # exit(0) from its handler, many perl versions produce the warning "refcnt:
  # fd -1 < 0", because exit() attempts to close the pipe for the second time.

  $pid = fork();
  if (!defined($pid))  { exit(1); }

  if (!$pid) {

    # we are in the grandchild process now... close the write end of
    # the pipe and connect the standard input to the read end of the pipe

    close($write);
    if (!open(STDIN, "<&", $read))  { exit(1); }
    close($read);

    # set SIGPIPE handling back to default before calling exec() (SIGPIPE is
    # ignored and exec() will only reset custom signal handlers to default)

    $SIG{PIPE} = 'DEFAULT';

    # set SIGTERM handling back to default (terminate) before calling exec();
    # if this process has received SIGTERM before default handling became
    # active, terminate the process without calling exec()

    $SIG{TERM} = 'DEFAULT';

    if (exists($terminate{$$}))  { exit(0); }

    # execute commandline - by default exec() keeps file descriptors 0..2 open
    # and closes other descriptors (see $^F special variable in perl docs);
    # if commandline must be executed without shell interpretation, call
    # exec() with list of commandline arguments and provide the first element
    # of the list as indirect object { $cmdline->[0] } (that disables shell
    # interpretation even if list has one element)

    if ($shell) {
      exec($cmdline);
    } else {
      exec { $cmdline->[0] } @{$cmdline};
    }

    exit(1);
  }

  # we are in the child process now (grandchild is our child)...
  # close the read end of the pipe and make the write end unbuffered

  close($read);
  select($write);
  $| = 1;

  # Set a new signal handler for SIGTERM that forwards it to child process
  # and exits. Since the handler could be triggered after blocking waitpid()
  # has returned and reaped the child from process table, the presence of
  # child is verified with nonblocking waitpid() before forwarding SIGTERM.
  # If the current process has received SIGTERM before the new handler became
  # active, forward SIGTERM to child process and exit (child must exist since
  # waitpid() has not been called yet for child).

  $SIG{TERM} = sub { my($ret) = waitpid($pid, WNOHANG);
                     if ($ret == -1) { exit(0); }
                     if ($ret != 0 && ($WIN32 || WIFEXITED($?) ||
                                       WIFSIGNALED($?))) { exit(0); }
                     kill('TERM', $pid);
                     exit(0); };

  if (exists($terminate{$$})) {
    kill('TERM', $pid);
    exit(0);
  }

  # since this process does not call exec() which closes all file descriptors
  # apart from 0..2 (see $^F special variable in perl docs), close all inputs,
  # outputs, the logfile, and connection to the system logger (if this is not
  # done, removed input/output files and connections established over sockets
  # would be kept open even after the parent process has closed them)

  %inputsrc = ();

  close_outputs();

  if ($logopen)  { close($loghandle); }
  if ($syslogopen)  { eval { Sys::Syslog::closelog() }; }

  # write data to pipe in blocking mode (ignoring SIGPIPE is inherited from
  # the main SEC process and writing to pipe is thus safe)

  if (ref($ref) eq "HASH") {
    while ($elem = each(%{$ref}))  { print $write $elem, "\n"; }
  } else {
    foreach $elem (@{$ref})  { print $write $elem, "\n"; }
  }

  # close the pipe immediately after writing (many commands don't terminate
  # without seeing EOF in stdin and without close() there would be deadlock)

  close($write);

  for (;;) {

    # wait for child process in blocking mode; waitpid() returns the pid
    # of the exited child process, return value -1 means there is no child
    # process with the given pid, while 0 means the child is still running

    $p = waitpid($pid, 0);

    # call exit(1) if according to waitpid() the child does not exist (i.e.,
    # its exit code has already been collected which should never happen)

    if ($p == -1)  { exit(1); }

    # if the child has exited, return its exit code with exit()

    if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) {
      exit($? >> 8);
    }
  }

}


# Parameters: par1 - host
#             par2 - port
#             par3 - protocol
# Action: Create the socket and address information data structure for
#         communicating with remote peer at host par1 and port par2 over
#         protocol par3. On success, return socket filehandle and address
#         information data structure, otherwise return undef.

sub create_sock_addr {

  my($host, $port, $proto) = @_;
  my($handle, $socktype, $iaddr, $paddr, $errlogged);
  my($err, $addrinfo, @addrinfo, %hints);

  # set the socket type according to protocol

  if ($proto eq "tcp") { $socktype = SOCK_STREAM; }
  elsif ($proto eq "udp") { $socktype = SOCK_DGRAM; }
  else {
    log_msg(LOG_ERR, "Creating sockets for protocol $proto is not supported");
    return undef;
  }

  # if perl Socket module has getaddrinfo() function which supports both
  # ipv4 and ipv6, use it for creating the socket; if we are dealing with
  # older perl version where Socket module comes without getaddrinfo(), use
  # traditional ipv4-only inet_aton() based approach for creating the socket

  if (defined(&Socket::getaddrinfo)) {

    # set up the hints data structure for getaddrinfo() -- note that
    # if socket type is not provided as a hint, getaddrinfo() returns
    # an error on some platforms if service port specification is not
    # textual but numeric

    $hints{"socktype"} = $socktype;
    $hints{"protocol"} = getprotobyname($proto);

    ($err, @addrinfo) = Socket::getaddrinfo($host, $port, \%hints);

    if ($err) {
      log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto ($err)");
      return undef;
    }

    # go through addrinfo list and try to create sockets for list elements,
    # returning the first successfully created socket (an attempt for first
    # list element might not always succeed, e.g., consider a scenario
    # where the first element represents an ipv6 address and the second
    # element ipv4 address, while the local host only supports ipv4)

    $paddr = undef;
    $errlogged = 0;

    foreach $addrinfo (@addrinfo) {

      if (!socket($handle, $addrinfo->{"family"},
                           $addrinfo->{"socktype"},
                           $addrinfo->{"protocol"})) {
        $errlogged = 1;
        log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)");
        next;
      }

      $paddr = $addrinfo->{"addr"};
      last;
    }

    # if the creation of the socket failed in the above loop, return undef

    if (!defined($paddr)) { return undef; }

    # if socket was successfully created in the above loop, but one (or more)
    # loop iteration(s) failed and produced error message(s), log a message
    # about successful creation of the socket

    if ($errlogged) {
      log_msg(LOG_DEBUG, "Socket for $host:$port/$proto successfully created");
    }

  } else {

    $iaddr = inet_aton($host);

    if (!defined($iaddr)) {
      log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto",
      "(unable to convert $host to Internet address)");
      return undef;
    }

    $paddr = sockaddr_in($port, $iaddr);

    if (!socket($handle, PF_INET, $socktype, getprotobyname($proto))) {
      log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)");
      return undef;
    }

  }

  return ($handle, $paddr);

}


# Parameters: par1 - handle of the socket
#             par2 - event
#             par3 - name of the destination
# Action: Send event par2 to socket par1 with the send(2) system call, and
#         produce a log message in the case of an error. In the log message,
#         par3 reflects the destination, and the message is logged with debug
#         level, in order to prevent message floods with higher severity when
#         large amounts of data are transfered. Return 0 if send(2) failed,
#         so that the socket should be closed; return 1 if event was partially
#         transmitted or could not be transmitted due to perl wide characters
#         or insufficient buffer space; return 2 on successful transmission.

sub send_to_socket {

  my($socket, $event, $dest) = @_;
  my($nbytes);

  for (;;) {

    # if the event contains perl wide characters, send() will die,
    # thus eval is used for calling it; according to posix, EWOULDBLOCK
    # or EAGAIN indicates that the socket buffer is full, while EMSGSIZE
    # means that the message is too large for the given socket type

    $nbytes = eval { send($socket, $event, 0) };

    if ($@) {
      log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($@)");
      return 1;
    } elsif (!defined($nbytes)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($!)");
      if ($! == EWOULDBLOCK || $! == EAGAIN || $! == EMSGSIZE)  { return 1; }
      return 0;
    } elsif ($nbytes != length($event)) {
      log_msg(LOG_DEBUG, "$nbytes bytes of '$event' sent to $dest");
      return 1;
    } else {
      return 2;
    }

  }
}


# Parameters: par1 - handle of the socket
#             par2 - operation type (0 denotes reading and 1 writing)
# Action: Check if socket par1 is ready for operation par2 (i.e., whether
#         the socket is ready for reading or writing); return 1 if socket
#         par1 is ready for operation par2, otherwise return 0

sub socket_ready {

  my($socket, $operation) = @_;
  my($bitmask, $ret);

  for (;;) {

    # create the bitmask for socket handle

    $bitmask = '';
    vec($bitmask, fileno($socket), 1) = 1;

    # poll the socket with select() if it is ready for reading or writing

    if ($operation) { $ret = select(undef, $bitmask, undef, 0); }
      else { $ret = select($bitmask, undef, undef, 0); }

    # if select() fails with EINTR, try again, otherwise quit the polling

    if ((!defined($ret) || $ret < 0) && $! == EINTR) { next; } else { last; }
  }

  # if the socket is ready, return 1, otherwise return 0

  if (defined($ret) && $ret > 0) { return 1; } else { return 0; }
}


# Parameters: par1 - reference to the socket hash table for new connections
#             par2 - reference to the socket hash table for connections with
#                    completed establishment
#             par3 - peer ID that identifies socket in tables par1 and par2
#             par4 - textual peer type
# Action: Check the status of a connection which is not yet established and
#         corresponds to socket par3 in table par1. If the establishment of
#         the connection is complete, move the socket par3 from table par1
#         to table par2. Textual peer type par4 and peer ID par3 are used
#         in error log messages, and messages are logged with debug level,
#         in order to prevent message floods with higher severity when large
#         amounts of data are transfered.

sub check_new_conn {

  my($new_sockets, $est_sockets, $peer, $peertype) = @_;
  my($event);

  # Check if socket is writable (indicates that connection establishment
  # has completed either successfully or with error).
  # If the establishment is still incomplete and the establishment timeout
  # has been reached, close the socket, drop all previously buffered data,
  # and return. If the establishment timeout has not been reached, return.

  if (!socket_ready($new_sockets->{$peer}->{"socket"}, 1)) {

    if (time() - $new_sockets->{$peer}->{"time"} > $socket_timeout) {
      log_msg(LOG_DEBUG, "Can't connect to $peertype '$peer'",
                         "(connection establishment timeout)");
      delete $new_sockets->{$peer};
    }

    return;
  }

  # If socket is writable, try to transmit all buffered events.
  # In the case of hard errors from send(2), retransmission is not attempted
  # and data are not buffered, but socket is closed (note that if connection
  # establishment completed with error, sending the first buffered event will
  # produce a hard send(2) error and socket will be closed).

  foreach $event (@{$new_sockets->{$peer}->{"buffer"}}) {

    if (!send_to_socket($new_sockets->{$peer}->{"socket"}, $event,
                                                "$peertype '$peer'")) {
      delete $new_sockets->{$peer};
      return;
    }
  }

  $est_sockets->{$peer} = $new_sockets->{$peer}->{"socket"};
  delete $new_sockets->{$peer};
}


# Parameters: par1 - reference to a list of actions
#             par2 - event description text
#             par3 - pointer into the list of actions
# Action: execute an action from a given action list, and return
#         an offset for advancing the pointer par3

sub execute_none_action { return 1; }

sub execute_logonly_action {

  my($actionlist, $text, $i) = @_;
  my($event);

  $event = $actionlist->[$i+1];
  substitute_actionlist_var($event, $text);
  log_msg(LOG_NOTICE, $event);

  return 2;
}

sub execute_write_action {

  my($actionlist, $text, $i) = @_;
  my($action, $file, $event);
  my($handle, $nbytes, $len);

  # since this function is used for both 'write' and 'writen' actions,
  # set $action to the action type
  $action = $actionlist->[$i];

  $file = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($file, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors are
  # logged at the debug level, in order to prevent message floods with
  # higher severity when larger amounts of data are transfered

  log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'");

  if (!exists($output_files{$file})) {

    if ($file eq "-") {

      while (!open($handle, ">&STDOUT")) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_ERR, "Can't dup stdout for writing event '$event' ($!)");
        return 3;
      }
      $output_files{$file} = $handle;

    } elsif (-e $file  &&  ! -f $file  &&  ! -p $file) {

      log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'",
              "(not a regular file or pipe)");
      return 3;

    } elsif (-p $file) {

      while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
        return 3;
      }
      $output_files{$file} = $handle;

    } else {

      while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
        return 3;
      }
      $output_files{$file} = $handle;

    }
  }

  for (;;) {

    # if the event contains perl wide characters, syswrite() will die,
    # thus eval is used for calling it

    if ($action == WRITE) {
      $len = length($event) + 1;
      $nbytes = eval { syswrite($output_files{$file}, "$event\n") };
    } else {
      $len = length($event);
      $nbytes = eval { syswrite($output_files{$file}, "$event") };
    }

    if ($@) {
      log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)");
    } elsif (!defined($nbytes)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)");
      delete $output_files{$file};
    } elsif ($nbytes != $len) {
      log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'");
    }

    return 3;
  }
}

sub execute_closef_action {

  my($actionlist, $text, $i) = @_;
  my($file);

  $file = $actionlist->[$i+1];
  substitute_actionlist_var($file, $text);

  log_msg(LOG_DEBUG, "Closing file '$file'");

  if (exists($output_files{$file})) {
    if (!close($output_files{$file})) {
      log_msg(LOG_WARN, "Error when closing file '$file' ($!)");
    }
    delete $output_files{$file};
  } else {
    log_msg(LOG_DEBUG, "File '$file' is not open, can't close");
  }

  return 2;
}

sub execute_owritecl_action {

  my($actionlist, $text, $i) = @_;
  my($file, $event, $handle, $nbytes);

  $file = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($file, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors are
  # logged at the debug level, in order to prevent message floods with
  # higher severity when larger amounts of data are transfered

  log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'");

  if ($file eq "-") {

    select(STDOUT);
    $| = 1;
    print STDOUT "$event";
    return 3;

  } elsif (-e $file  &&  ! -f $file  &&  ! -p $file) {

    log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'",
            "(not a regular file or pipe)");
    return 3;

  } elsif (-p $file) {

    while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
      return 3;
    }

  } else {

    while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)");
      return 3;
    }
  }

  for (;;) {

    # if the event contains perl wide characters, syswrite() will die,
    # thus eval is used for calling it

    $nbytes = eval { syswrite($handle, $event) };

    if ($@) {
      log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)");
    } elsif (!defined($nbytes)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)");
    } elsif ($nbytes != length($event)) {
      log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'");
    }

    close($handle);
    return 3;
  }
}

sub execute_udgram_action {

  my($actionlist, $text, $i) = @_;
  my($file, $event, $handle);

  $file = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($file, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors with
  # local peers are logged at the debug level, in order to prevent message
  # floods with higher severity when large amounts of data are transfered

  log_msg(LOG_DEBUG, "Sending event '$event' to unix datagram socket '$file'");

  # if the socket already exists, use it for transmitting data; if the
  # transmission fails with hard error from send(2) (e.g., the server has
  # been restarted and the socket file has been recreated), close the socket
  # and attempt retransmission, otherwise return immediately

  if (exists($output_udgram{$file})) {

    if (send_to_socket($output_udgram{$file}, $event, "socket '$file'")) {
      return 3;
    }

    log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'");
    delete $output_udgram{$file};
  }

  # create the socket for communicating with local peer

  if (! -S $file) {
    log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'",
            "(socket does not exist)");
    return 3;
  }

  if (!socket($handle, PF_UNIX, SOCK_DGRAM, 0)) {
    log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)");
    return 3;
  }

  # Connect to local peer (connect() returns immediately for connectionless
  # sockets). Since EINTR error should not happen for connectionless sockets
  # on posix systems and on many platforms connect() should not be called
  # again after EINTR, there is no special handling for EINTR.

  if (!connect($handle, sockaddr_un($file))) {
    log_msg(LOG_DEBUG,
            "Can't connect to socket '$file' for sending event '$event' ($!)");
    return 3;
  }

  # switch the socket to non-blocking mode for all further communications

  $handle->blocking(0);
  $output_udgram{$file} = $handle;

  # transmit data to local peer (close the socket on hard send(2) error)

  if (!send_to_socket($output_udgram{$file}, $event, "socket '$file'")) {
    delete $output_udgram{$file};
  }

  return 3;
}

sub execute_closeudgr_action {

  my($actionlist, $text, $i) = @_;
  my($file);

  $file = $actionlist->[$i+1];
  substitute_actionlist_var($file, $text);

  log_msg(LOG_DEBUG, "Closing unix datagram socket '$file'");

  if (exists($output_udgram{$file})) {
    if (!close($output_udgram{$file})) {
      log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
    }
    delete $output_udgram{$file};
  } else {
    log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close");
  }

  return 2;
}

sub execute_ustream_action {

  my($actionlist, $text, $i) = @_;
  my($file, $event, $handle);

  $file = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($file, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors with
  # local peers are logged at the debug level, in order to prevent message
  # floods with higher severity when large amounts of data are transfered

  log_msg(LOG_DEBUG, "Sending event '$event' to unix stream socket '$file'");

  # If the socket exists and there is an established connection to local
  # peer, send data to the peer. If sending failed with a hard error from
  # send(2), close the socket and attempt resending with a newly created
  # socket later in the function, otherwise return immediately.

  if (exists($output_ustream{$file})) {

    if (send_to_socket($output_ustream{$file}, $event, "socket '$file'")) {
      return 3;
    }

    log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'");
    delete $output_ustream{$file};
  }

  # the socket exists but the connection establishment is not complete

  elsif (exists($output_ustrconn{$file})) {

    # buffer the event

    push @{$output_ustrconn{$file}->{"buffer"}}, $event;

    # Check the status of the connection, and if the connection establishment
    # has completed, try to transmit all buffered events. If no hard send(2)
    # errors were encountered during transmission, regard the connection as
    # successfully established, and move the socket from %output_ustrconn hash
    # to %output_ustream hash. Otherwise, close the socket.

    check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket");

    return 3;
  }

  # If the socket did not exist previously or the established connection
  # was closed because of an error, recreate the socket and attempt to
  # establish a new connection for transmitting data to local peer

  if (! -S $file) {
    log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'",
            "(socket does not exist)");
    return 3;
  }

  if (!socket($handle, PF_UNIX, SOCK_STREAM, 0)) {
    log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)");
    return 3;
  }

  # Connect to local peer -- although calling connect() for blocking unix
  # stream socket will usually return immediately, there are cases when
  # connect() might block (e.g., on Linux when server listen backlog is full).
  # For handling such cases, the socket will be switched to non-blocking
  # mode before calling connect(). If the connection to local peer is not
  # established immediately (EINPROGRESS on posix systems), buffer the data
  # for future transmission and return. Note that on Linux EINPROGRESS is
  # never returned for unix stream sockets, but rather EAGAIN which is never
  # returned on posix systems. Since EINTR error should not happen on posix
  # systems for non-blocking sockets, and on many platforms connect() should
  # not be called again after EINTR, there is no special handling for EINTR.

  $handle->blocking(0);

  if (!connect($handle, sockaddr_un($file))) {
    if ($! == EINPROGRESS || $! == EAGAIN) {
      $output_ustrconn{$file} = { "socket" => $handle,
                                  "buffer" => [ $event ],
                                  "time" => time() };
    } else {
      log_msg(LOG_DEBUG,
      "Can't connect to socket '$file' for sending event '$event' ($!)");
    }
    return 3;
  }

  $output_ustream{$file} = $handle;

  # transmit data to local peer (close the socket on hard send(2) error)

  if (!send_to_socket($output_ustream{$file}, $event, "socket '$file'")) {
    delete $output_ustream{$file};
  }

  return 3;
}

sub execute_closeustr_action {

  my($actionlist, $text, $i) = @_;
  my($file);

  $file = $actionlist->[$i+1];
  substitute_actionlist_var($file, $text);

  log_msg(LOG_DEBUG, "Closing unix stream socket '$file'");

  if (exists($output_ustream{$file})) {
    if (!close($output_ustream{$file})) {
      log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
    }
    delete $output_ustream{$file};
  } elsif (exists($output_ustrconn{$file})) {
    if (!close($output_ustrconn{$file}->{"socket"})) {
      log_msg(LOG_WARN, "Error when closing socket '$file' ($!)");
    }
    delete $output_ustrconn{$file};
  } else {
    log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close");
  }

  return 2;
}

sub execute_udpsock_action {

  my($actionlist, $text, $i) = @_;
  my($peer, $event, $host, $port, $handle, $addr);

  $peer = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($peer, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors with
  # remote peers are logged at the debug level, in order to prevent message
  # floods with higher severity when large amounts of data are transfered

  log_msg(LOG_DEBUG, "Sending event '$event' to UDP peer '$peer'");

  # if the socket already exists, use it for transmitting data; if the
  # transmission fails with hard error from send(2) (e.g., server responded
  # with ICMP port unreachable to previous transmission which raises an error
  # condition for the socket), close the socket and attempt retransmission,
  # otherwise return immediately

  if (exists($output_udpsock{$peer})) {

    if (send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) {
      return 3;
    }

    log_msg(LOG_DEBUG, "Retrying to send event '$event' to UDP peer '$peer'");
    delete $output_udpsock{$peer};
  }

  # create the socket for communicating with remote peer

  if ($peer !~ /^(.+):([0-9]+)$/) {
    log_msg(LOG_WARN,
    "Can't connect to UDP peer '$peer' for sending event '$event'",
    "(peer not in host:portnumber format)");
    return 3;
  }

  $host = $1;
  $port = $2;

  ($handle, $addr) = create_sock_addr($host, $port, "udp");

  if (!defined($handle)) {
    log_msg(LOG_DEBUG,
            "Can't connect to UDP peer '$peer' for sending event '$event'");
    return 3;
  }

  # Connect to remote peer (connect() returns immediately for connectionless
  # sockets). Since EINTR error should not happen for connectionless sockets
  # on posix systems, and on many platforms connect() should not be called
  # again after EINTR, there is no special handling for EINTR.

  if (!connect($handle, $addr)) {
    log_msg(LOG_DEBUG,
    "Can't connect to UDP peer '$peer' for sending event '$event' ($!)");
    return 3;
  }

  # switch the socket to non-blocking mode for all further communications

  $handle->blocking(0);
  $output_udpsock{$peer} = $handle;

  # transmit data to remote peer (close the socket on hard send(2) error)

  if (!send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) {
    delete $output_udpsock{$peer};
  }

  return 3;
}

sub execute_closeudp_action {

  my($actionlist, $text, $i) = @_;
  my($peer);

  $peer = $actionlist->[$i+1];
  substitute_actionlist_var($peer, $text);

  log_msg(LOG_DEBUG, "Closing socket for UDP peer '$peer'");

  if (exists($output_udpsock{$peer})) {
    if (!close($output_udpsock{$peer})) {
      log_msg(LOG_WARN, "Error when closing socket for UDP peer '$peer' ($!)");
    }
    delete $output_udpsock{$peer};
  } else {
    log_msg(LOG_DEBUG, "No socket for UDP peer '$peer', can't close");
  }

  return 2;
}

sub execute_tcpsock_action {

  my($actionlist, $text, $i) = @_;
  my($peer, $event, $host, $port, $handle, $addr);

  $peer = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($peer, $text);
  substitute_actionlist_var($event, $text);

  # apart from unexpected local system errors, communication errors with
  # remote peers are logged at the debug level, in order to prevent message
  # floods with higher severity when large amounts of data are transfered

  log_msg(LOG_DEBUG, "Sending event '$event' to TCP peer '$peer'");

  # If the socket exists and there is an established connection to remote
  # peer, send data to the peer. If sending failed with a hard error from
  # send(2), close the socket and attempt resending with a newly created
  # socket later in the function, otherwise return immediately.

  if (exists($output_tcpsock{$peer})) {

    if (send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) {
      return 3;
    }

    log_msg(LOG_DEBUG, "Retrying to send event '$event' to TCP peer '$peer'");
    delete $output_tcpsock{$peer};
  }

  # the socket exists but the connection establishment is not complete

  elsif (exists($output_tcpconn{$peer})) {

    # buffer the event

    push @{$output_tcpconn{$peer}->{"buffer"}}, $event;

    # Check the status of the connection, and if the connection establishment
    # has completed, try to transmit all buffered events. If no hard send(2)
    # errors were encountered during transmission, regard the connection as
    # successfully established, and move the socket from %output_tcpconn hash
    # to %output_tcpsock hash. Otherwise, close the socket.

    check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer");

    return 3;
  }

  # If the socket did not exist previously or the established connection
  # was closed because of an error, recreate the socket and attempt to
  # establish a new connection for transmitting data to remote peer

  if ($peer !~ /^(.+):([0-9]+)$/) {
     log_msg(LOG_WARN,
     "Can't connect to TCP peer '$peer' for sending event '$event'",
     "(peer not in host:portnumber format)");
     return 3;
  }

  $host = $1;
  $port = $2;

  ($handle, $addr) = create_sock_addr($host, $port, "tcp");

  if (!defined($handle)) {
    log_msg(LOG_DEBUG,
            "Can't connect to TCP peer '$peer' for sending event '$event'");
    return 3;
  }

  # Connect to remote peer -- for avoiding blocking connect(), socket will be
  # switched to non-blocking mode before calling connect(). If the connection
  # to remote peer is not established immediately (EINPROGRESS), buffer the
  # data for future transmission and return. Since EINTR error should not
  # happen on posix systems for non-blocking sockets, and on many platforms
  # connect() should not be called again after EINTR, there is no special
  # handling for EINTR.

  $handle->blocking(0);

  if (!connect($handle, $addr)) {
    if ($! == EINPROGRESS) {
      $output_tcpconn{$peer} = { "socket" => $handle,
                                 "buffer" => [ $event ],
                                 "time" => time() };
    } else {
      log_msg(LOG_DEBUG,
      "Can't connect to TCP peer '$peer' for sending event '$event' ($!)");
    }
    return 3;
  }

  $output_tcpsock{$peer} = $handle;

  # transmit data to remote peer (close the socket on hard send(2) error)

  if (!send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) {
    delete $output_tcpsock{$peer};
  }

  return 3;
}

sub execute_closetcp_action {

  my($actionlist, $text, $i) = @_;
  my($peer);

  $peer = $actionlist->[$i+1];
  substitute_actionlist_var($peer, $text);

  log_msg(LOG_DEBUG, "Closing socket for TCP peer '$peer'");

  if (exists($output_tcpsock{$peer})) {
    if (!close($output_tcpsock{$peer})) {
      log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)");
    }
    delete $output_tcpsock{$peer};
  } elsif (exists($output_tcpconn{$peer})) {
    if (!close($output_tcpconn{$peer}->{"socket"})) {
      log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)");
    }
    delete $output_tcpconn{$peer};
  } else {
    log_msg(LOG_DEBUG, "No socket for TCP peer '$peer', can't close");
  }

  return 2;
}

sub execute_shellcmd_action {

  my($actionlist, $text, $i) = @_;
  my($cmdline, $text2);

  $cmdline = $actionlist->[$i+1];
  $text2 = $text;

  # if -quoting flag was specified, mask apostrophes in $text2
  # and put $text2 inside apostrophes

  if ($quoting) {
    $text2 =~ s/'/'\\''/g;
    $text2 = "'" . $text2 . "'";
  }

  substitute_actionlist_var($cmdline, $text2);

  log_msg(LOG_INFO, "Executing shell command '$cmdline'");

  exec_cmd($cmdline);

  return 2;
}

sub execute_cmdexec_action {

  my($actionlist, $text, $i) = @_;
  my(@cmdline, $cmdline, $arg);

  @cmdline = @{$actionlist->[$i+1]};

  foreach $arg (@cmdline)  { substitute_actionlist_var($arg, $text); }

  $cmdline = join(" ", @cmdline);

  log_msg(LOG_INFO, "Executing command '$cmdline'");

  exec_cmd(\@cmdline);

  return 2;
}

sub execute_spawn_action {

  my($actionlist, $text, $i) = @_;
  my($cmdline, $text2);

  $cmdline = $actionlist->[$i+1];
  $text2 = $text;

  # if -quoting flag was specified, mask apostrophes in $text2
  # and put $text2 inside apostrophes

  if ($quoting) {
    $text2 =~ s/'/'\\''/g;
    $text2 = "'" . $text2 . "'";
  }

  substitute_actionlist_var($cmdline, $text2);

  log_msg(LOG_INFO, "Spawning shell command '$cmdline'");

  exec_cmd($cmdline, 1);

  return 2;
}

sub execute_spawnexec_action {

  my($actionlist, $text, $i) = @_;
  my(@cmdline, $cmdline, $arg);

  @cmdline = @{$actionlist->[$i+1]};

  foreach $arg (@cmdline)  { substitute_actionlist_var($arg, $text); }

  $cmdline = join(" ", @cmdline);

  log_msg(LOG_INFO, "Spawning command '$cmdline'");

  exec_cmd(\@cmdline, 1);

  return 2;
}

sub execute_cspawn_action {

  my($actionlist, $text, $i) = @_;
  my($context, $cmdline, $text2);

  $context = $actionlist->[$i+1];
  $cmdline = $actionlist->[$i+2];
  $text2 = $text;

  # if -quoting flag was specified, mask apostrophes in $text2
  # and put $text2 inside apostrophes

  if ($quoting) {
    $text2 =~ s/'/'\\''/g;
    $text2 = "'" . $text2 . "'";
  }

  substitute_actionlist_var($context, $text2);
  substitute_actionlist_var($cmdline, $text2);

  log_msg(LOG_INFO,
          "Spawning shell command '$cmdline' with context '$context'");

  exec_cmd($cmdline, 1, $context);

  return 3;
}

sub execute_cspawnexec_action {

  my($actionlist, $text, $i) = @_;
  my(@cmdline, $cmdline, $context, $arg);

  $context = $actionlist->[$i+1];
  @cmdline = @{$actionlist->[$i+2]};

  substitute_actionlist_var($context, $text);

  foreach $arg (@cmdline)  { substitute_actionlist_var($arg, $text); }

  $cmdline = join(" ", @cmdline);

  log_msg(LOG_INFO, "Spawning command '$cmdline' with context '$context'");

  exec_cmd(\@cmdline, 1, $context);

  return 3;
}

sub execute_pipe_action {

  my($actionlist, $text, $i) = @_;
  my($event, $cmdline);

  $event = $actionlist->[$i+1];
  $cmdline = $actionlist->[$i+2];

  substitute_actionlist_var($event, $text);
  substitute_actionlist_var($cmdline, $text);

  log_msg(LOG_INFO, "Feeding event '$event' to shell command '$cmdline'");

  if (length($cmdline)) {
    pipe_cmd($cmdline, [ $event ]);
  } else {
    select(STDOUT);
    $| = 1;
    print STDOUT "$event\n";
  }

  return 3;
}

sub execute_pipeexec_action {

  my($actionlist, $text, $i) = @_;
  my(@cmdline, $cmdline, $event, $arg);

  $event = $actionlist->[$i+1];
  @cmdline = @{$actionlist->[$i+2]};

  substitute_actionlist_var($event, $text);

  foreach $arg (@cmdline)  { substitute_actionlist_var($arg, $text); }

  $cmdline = join(" ", @cmdline);

  log_msg(LOG_INFO, "Feeding event '$event' to command '$cmdline'");

  if (scalar(@cmdline)) {
    pipe_cmd(\@cmdline, [ $event ]);
  } else {
    select(STDOUT);
    $| = 1;
    print STDOUT "$event\n";
  }

  return 3;
}

sub execute_create_action {

  my($actionlist, $text, $i) = @_;
  my($context, $lifetime, $list);

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

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($lifetime, $text);

  log_msg(LOG_DEBUG, "Creating context '$context'");

  if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) {

    $lifetime = $1;

    if (exists($context_list{$context})) {

      if (!exists($context_list{$context}->{"Internal"})) {

        $context_list{$context}->{"Time"} = time();
        $context_list{$context}->{"Window"} = $lifetime;
        $context_list{$context}->{"Action"} = $list;
        $context_list{$context}->{"Desc"} = $text;
        @{$context_list{$context}->{"Buffer"}} = ();

      } else {
        log_msg(LOG_WARN,
        "Invalid use of create action for internal context '$context'");
      }

    } else {

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

    }

  } else {
    log_msg(LOG_WARN,
    "Invalid lifetime '$lifetime' for context '$context', can't create");
  }

  return 4;
}

sub execute_delete_action {

  my($actionlist, $text, $i) = @_;
  my($context, $alias);

  $context = $actionlist->[$i+1];
  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Deleting context '$context'");

  if (exists($context_list{$context})  &&
      !exists($context_list{$context}->{"DeleteInProgress"})) {

    if (!exists($context_list{$context}->{"Internal"})) {

      foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) {
        delete $context_list{$alias};
        log_msg(LOG_DEBUG, "Context '$alias' deleted");
      }

    } else {
      log_msg(LOG_WARN,
      "Invalid use of delete action for internal context '$context'");
    }

  } else {
    log_msg(LOG_DEBUG,
    "Context '$context' does not exist or is already going through deletion");
  }

  return 2;
}

sub execute_obsolete_action {

  my($actionlist, $text, $i) = @_;
  my($context);

  $context = $actionlist->[$i+1];
  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Obsoleting context '$context'");

  if (exists($context_list{$context})  &&
      !exists($context_list{$context}->{"DeleteInProgress"})) {

    if (!exists($context_list{$context}->{"Internal"})) {
      $context_list{$context}->{"Window"} = -1;
      valid_context($context);
    } else {
      log_msg(LOG_WARN,
      "Invalid use of obsolete action for internal context '$context'");
    }

  } else {
    log_msg(LOG_DEBUG,
    "Context '$context' does not exist or is already going through deletion");
  }

  return 2;
}

sub execute_set_action {

  my($actionlist, $text, $i) = @_;
  my($context, $lifetime, $list);

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

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($lifetime, $text);

  log_msg(LOG_DEBUG, "Changing settings for context '$context'");

  if ($lifetime =~ /^\s*(?:0*([0-9]+)|-)\s*$/) {

    $lifetime = $1;

    if (exists($context_list{$context})) {

      if (!exists($context_list{$context}->{"Internal"})) {

        if (defined($lifetime)) {
          $context_list{$context}->{"Time"} = time();
          $context_list{$context}->{"Window"} = $lifetime;
        }

        if (scalar(@{$list})) {
          $context_list{$context}->{"Action"} = $list;
          $context_list{$context}->{"Desc"} = $text;
        }

      } else {
        log_msg(LOG_WARN,
        "Invalid use of set action for internal context '$context'");
      }

    } else {
      log_msg(LOG_WARN,
              "Context '$context' does not exist, can't change settings");
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid lifetime '$lifetime' for context '$context', can't change settings");
  }

  return 4;
}

sub execute_alias_action {

  my($actionlist, $text, $i) = @_;
  my($context, $alias);

  $context = $actionlist->[$i+1];
  $alias = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($alias, $text);

  log_msg(LOG_DEBUG, "Creating alias '$alias' for context '$context'");

  if (!exists($context_list{$context})) {
    log_msg(LOG_WARN,
            "Context '$context' does not exist, can't create alias");
  } elsif (exists($context_list{$alias})) {
    log_msg(LOG_DEBUG, "Alias '$alias' already exists");
  } elsif (!exists($context_list{$context}->{"Internal"})) {
    $context_list{$context}->{"Aliases"}->{$alias} = 1;
    $context_list{$alias} = $context_list{$context};
  } else {
    log_msg(LOG_WARN,
    "Invalid use of alias action for internal context '$context'");
  }

  return 3;
}

sub execute_unalias_action {

  my($actionlist, $text, $i) = @_;
  my($alias);

  $alias = $actionlist->[$i+1];
  substitute_actionlist_var($alias, $text);

  log_msg(LOG_DEBUG, "Removing alias '$alias'");

  if (exists($context_list{$alias})  &&
      !exists($context_list{$alias}->{"DeleteInProgress"})) {

    if (!exists($context_list{$alias}->{"Internal"})) {

      delete $context_list{$alias}->{"Aliases"}->{$alias};

      if (!scalar(%{$context_list{$alias}->{"Aliases"}})) {
        log_msg(LOG_DEBUG,
                "Alias '$alias' was the last reference to a context");
      }

      delete $context_list{$alias};

    } else {
      log_msg(LOG_WARN,
      "Invalid use of unalias action for internal context '$alias'");
    }

  } else {
    log_msg(LOG_DEBUG, "Alias '$alias' does not exist or the referred context is already going through deletion");
  }

  return 2;
}

sub execute_add_action {

  my($actionlist, $text, $i) = @_;
  my($context, $event, @event);

  $context = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($event, $text);

  log_msg(LOG_DEBUG, "Adding event(s) '$event' to context '$context'");

  if (!exists($context_list{$context})) {

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

  if (!exists($context_list{$context}->{"Internal"})) {

    @event = split(/\n/, $event);  # split returns empty list for "" or undef

    if (!$evstoresize  ||  scalar(@{$context_list{$context}->{"Buffer"}})
                         + scalar(@event) <= $evstoresize) {
      push @{$context_list{$context}->{"Buffer"}}, @event;
    } else {
      log_msg(LOG_WARN,
      "Can't add event(s) '$event' to context '$context', store full");
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid use of add action for internal context '$context'");
  }

  return 3;
}

sub execute_prepend_action {

  my($actionlist, $text, $i) = @_;
  my($context, $event, @event);

  $context = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($event, $text);

  log_msg(LOG_DEBUG, "Prepending event(s) '$event' to context '$context'");

  if (!exists($context_list{$context})) {

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

  if (!exists($context_list{$context}->{"Internal"})) {

    @event = split(/\n/, $event);  # split returns empty list for "" or undef

    if (!$evstoresize  ||  scalar(@{$context_list{$context}->{"Buffer"}})
                         + scalar(@event) <= $evstoresize) {
      unshift @{$context_list{$context}->{"Buffer"}}, @event;
    } else {
      log_msg(LOG_WARN,
      "Can't prepend event(s) '$event' to context '$context', store full");
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid use of prepend action for internal context '$context'");
  }

  return 3;
}

sub execute_fill_action {

  my($actionlist, $text, $i) = @_;
  my($context, $event, @event);

  $context = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($event, $text);

  log_msg(LOG_DEBUG, "Filling context '$context' with event(s) '$event'");

  if (!exists($context_list{$context})) {

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

  if (!exists($context_list{$context}->{"Internal"})) {

    @event = split(/\n/, $event);  # split returns empty list for "" or undef

    if (!$evstoresize  ||  scalar(@event) <= $evstoresize) {
      @{$context_list{$context}->{"Buffer"}} = @event;
    } else {
      log_msg(LOG_WARN,
      "Can't fill context '$context' with event(s) '$event', store full");
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid use of fill action for internal context '$context'");
  }

  return 3;
}

sub execute_report_action {

  my($actionlist, $text, $i) = @_;
  my($context, $cmdline, $event);

  $context = $actionlist->[$i+1];
  $cmdline = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($cmdline, $text);

  log_msg(LOG_INFO, "Reporting the event store of context '$context' through shell command '$cmdline'");

  if (!exists($context_list{$context})) {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't report");
  } elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) {
    log_msg(LOG_DEBUG,
            "Event store of context '$context' is empty, nothing to report");
  } else {

    if (length($cmdline)) {
      pipe_cmd($cmdline, $context_list{$context}->{"Buffer"});
    } else {
      select(STDOUT);
      $| = 1;
      foreach $event (@{$context_list{$context}->{"Buffer"}}) {
        print STDOUT "$event\n";
      }
    }

  }

  return 3;
}

sub execute_reportexec_action {

  my($actionlist, $text, $i) = @_;
  my(@cmdline, $cmdline, $context, $event, $arg);

  $context = $actionlist->[$i+1];
  @cmdline = @{$actionlist->[$i+2]};

  substitute_actionlist_var($context, $text);

  foreach $arg (@cmdline)  { substitute_actionlist_var($arg, $text); }

  $cmdline = join(" ", @cmdline);

  log_msg(LOG_INFO, "Reporting the event store of context '$context' through command '$cmdline'");

  if (!exists($context_list{$context})) {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't report");
  } elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) {
    log_msg(LOG_DEBUG,
            "Event store of context '$context' is empty, nothing to report");
  } else {

    if (scalar(@cmdline)) {
      pipe_cmd(\@cmdline, $context_list{$context}->{"Buffer"});
    } else {
      select(STDOUT);
      $| = 1;
      foreach $event (@{$context_list{$context}->{"Buffer"}}) {
        print STDOUT "$event\n";
      }
    }

  }

  return 3;
}

sub execute_copy_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $context = $actionlist->[$i+1];
  $variable = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG,
          "Copying context '$context' to variable '%$variable'");

  if (exists($context_list{$context})) {

    $value = join("\n", @{$context_list{$context}->{"Buffer"}});
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");

  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't copy");
  }

  return 3;
}

sub execute_empty_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $context = $actionlist->[$i+1];
  $variable = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Emptying the event store of context '$context'");

  if (exists($context_list{$context})) {

    if (length($variable)) {
      $value = join("\n", @{$context_list{$context}->{"Buffer"}});
      $variables{$variable} = $value;
      log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
    }

    @{$context_list{$context}->{"Buffer"}} = ();

  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't empty");
  }

  return 3;
}

sub execute_pop_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $context = $actionlist->[$i+1];
  $variable = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Pop the last element of context '$context' event store into variable '%$variable'");

  if (exists($context_list{$context})) {

    $value = pop @{$context_list{$context}->{"Buffer"}};
    if (!defined($value))  { $value = ""; }
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");

  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't pop");
  }

  return 3;
}

sub execute_shift_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $context = $actionlist->[$i+1];
  $variable = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Shift the first element of context '$context' event store into variable '%$variable'");

  if (exists($context_list{$context})) {

    $value = shift @{$context_list{$context}->{"Buffer"}};
    if (!defined($value))  { $value = ""; }
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");

  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't shift");
  }

  return 3;
}

sub execute_exists_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $variable = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Checking the presence of context '$context'");

  $value = (exists($context_list{$context}))?1:0;
  $variables{$variable} = $value;

  log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");

  return 3;
}

sub execute_getsize_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $variable = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Finding the size of context '$context' event store");

  if (exists($context_list{$context})) {
    $value = scalar(@{$context_list{$context}->{"Buffer"}});
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
  } else {
    $variables{$variable} = undef;
    log_msg(LOG_DEBUG,
    "Context '$context' does not exist, variable '%$variable' set to undef");
  }

  return 3;
}

sub execute_getaliases_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $variable = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG,
  "Assigning aliases of context '$context' to variable '%$variable'");

  if (exists($context_list{$context})) {
    $value = join("\n", keys %{$context_list{$context}->{"Aliases"}});
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't get aliases");
  }

  return 3;
}

sub execute_getltime_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $variable = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG,
  "Assigning the lifetime of context '$context' to variable '%$variable'");

  if (exists($context_list{$context})) {
    $value = $context_list{$context}->{"Window"};
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
  } else {
    log_msg(LOG_WARN, "Context '$context' does not exist, can't get lifetime");
  }

  return 3;
}

sub execute_setltime_action {

  my($actionlist, $text, $i) = @_;
  my($context, $lifetime);

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

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($lifetime, $text);

  if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) {

    $lifetime = $1;

    log_msg(LOG_DEBUG,
            "Setting the lifetime of context '$context' to '$lifetime'");

    if (exists($context_list{$context})) {

      if (!exists($context_list{$context}->{"Internal"})) {

        $context_list{$context}->{"Window"} = $lifetime;

        if ($lifetime &&
            time() - $context_list{$context}->{"Time"} > $lifetime) {

          log_msg(LOG_DEBUG,
          "Context '$context' has become stale after lifetime adjustment");

          valid_context($context);
        }

      } else {
        log_msg(LOG_WARN,
        "Invalid use of setltime action for internal context '$context'");
      }

    } else {
      log_msg(LOG_WARN,
              "Context '$context' does not exist, can't set lifetime");
    }

  } else {
    log_msg(LOG_WARN, "Invalid lifetime '$lifetime' for context '$context'");
  }

  return 3;
}

sub execute_getctime_action {

  my($actionlist, $text, $i) = @_;
  my($context, $variable, $value);

  $variable = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG,
  "Assigning the creation time of context '$context' to variable '%$variable'");

  if (exists($context_list{$context})) {
    $value = $context_list{$context}->{"Time"};
    $variables{$variable} = $value;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
  } else {
    log_msg(LOG_WARN,
            "Context '$context' does not exist, can't get creation time");
  }

  return 3;
}

sub execute_setctime_action {

  my($actionlist, $text, $i) = @_;
  my($context, $timestamp);
  my($ltime, $time, $time2);

  $timestamp = $actionlist->[$i+1];
  $context = $actionlist->[$i+2];

  substitute_actionlist_var($timestamp, $text);
  substitute_actionlist_var($context, $text);

  if ($timestamp =~ /^\s*0*([0-9]+)\s*$/) {

    $timestamp = $1;
    $ltime = scalar(localtime($timestamp));

    log_msg(LOG_DEBUG,
            "Setting the creation time of context '$context' to '$ltime'");

    if (exists($context_list{$context})) {

      if (!exists($context_list{$context}->{"Internal"})) {

        $time = $context_list{$context}->{"Time"};
        $time2 = time();

        if ($timestamp < $time) {
          log_msg(LOG_WARN,
          "Can't set context creation time backwards to '$ltime'");
        } elsif ($timestamp > $time2) {
          log_msg(LOG_WARN,
          "Can't set context creation time into future to '$ltime'");
        } elsif ($timestamp == $time) {
          log_msg(LOG_DEBUG, "Context creation time already set to '$ltime'");
        } else {
          $context_list{$context}->{"Time"} = $timestamp;
        }

      } else {
        log_msg(LOG_WARN,
        "Invalid use of setctime action for internal context '$context'");
      }

    } else {
      log_msg(LOG_WARN,
      "Context '$context' does not exist, can't set creation time");
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid timestamp '$timestamp' for creation time of context '$context'");
  }

  return 3;
}

sub execute_event_action {

  my($actionlist, $text, $i) = @_;
  my($createafter, $event, @event);

  $createafter = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($event, $text);

  @event = split(/\n/, $event);  # split returns empty list for "" or undef

  if ($createafter) {
    foreach $event (@event) {
      log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds");
      push @pending_events, [ time() + $createafter, $event,
                              SYNEVENT_INT_CONTEXT ];
    }
  } else {
    foreach $event (@event) {
      log_msg(LOG_DEBUG, "Creating event '$event'");
      push @events, $event, SYNEVENT_INT_CONTEXT;
    }
  }

  return 3;
}

sub execute_tevent_action {

  my($actionlist, $text, $i) = @_;
  my($createafter, $event, @event);

  $createafter = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($createafter, $text);
  substitute_actionlist_var($event, $text);

  @event = split(/\n/, $event);  # split returns empty list for "" or undef

  if ($createafter =~ /^\s*0*([0-9]+)\s*$/) {

    $createafter = $1;

    if ($createafter) {
      foreach $event (@event) {
        log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds");
        push @pending_events, [ time() + $createafter, $event,
                                SYNEVENT_INT_CONTEXT ];
      }
    } else {
      foreach $event (@event) {
        log_msg(LOG_DEBUG, "Creating event '$event'");
        push @events, $event, SYNEVENT_INT_CONTEXT;
      }
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid time specification '$createafter' for creating events");
  }

  return 3;
}

sub execute_cevent_action {

  my($actionlist, $text, $i) = @_;
  my($context, $createafter, $event, @event);

  $context = $actionlist->[$i+1];
  $createafter = $actionlist->[$i+2];
  $event = $actionlist->[$i+3];

  substitute_actionlist_var($context, $text);
  substitute_actionlist_var($createafter, $text);
  substitute_actionlist_var($event, $text);

  @event = split(/\n/, $event);  # split returns empty list for "" or undef

  if ($createafter =~ /^\s*0*([0-9]+)\s*$/) {

    $createafter = $1;

    if ($createafter) {
      foreach $event (@event) {
        log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' with context '$context' after $createafter seconds");
        push @pending_events, [ time() + $createafter, $event, $context ];
      }
    } else {
      foreach $event (@event) {
        log_msg(LOG_DEBUG, "Creating event '$event' with context '$context'");
        push @events, $event, $context;
      }
    }

  } else {
    log_msg(LOG_WARN,
    "Invalid time specification '$createafter' for creating events");
  }

  return 4;
}

sub execute_reset_action {

  my($actionlist, $text, $i) = @_;
  my($conffile, $ruleid, $event);
  my($key, $rule);

  $conffile = $actionlist->[$i+1];
  $ruleid = $actionlist->[$i+2];
  $event = $actionlist->[$i+3];

  substitute_actionlist_var($event, $text);

  if (length($ruleid)) {

    $key = gen_key($conffile, $ruleid, $event);

    log_msg(LOG_DEBUG, "Terminating event correlation operation '$key'");

    $rule = $configuration{$conffile}->[$ruleid];

    if (exists($rule->{"Operations"})) {
      delete $rule->{"Operations"}->{$key};
    }
    delete $corr_list{$key};

  } else {

    log_msg(LOG_DEBUG,
            "Terminating all event correlation operations started from",
            $conffile, "with operation description string '$event'");

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

      $key = gen_key($conffile, $rule->{"ID"}, $event);

      if (exists($rule->{"Operations"})) {
        delete $rule->{"Operations"}->{$key};
      }
      delete $corr_list{$key};

    }
  }

  return 4;
}

sub execute_getwpos_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $conffile, $ruleid, $event);
  my($key, $time);

  $variable = $actionlist->[$i+1];
  $conffile = $actionlist->[$i+2];
  $ruleid = $actionlist->[$i+3];
  $event = $actionlist->[$i+4];

  substitute_actionlist_var($event, $text);
  $key = gen_key($conffile, $ruleid, $event);

  log_msg(LOG_DEBUG,
  "Getting event correlation window position for operation '$key'");

  if (exists($corr_list{$key})) {
    $time = $corr_list{$key}->{"Time"};
    $variables{$variable} = $time;
    log_msg(LOG_DEBUG, "Variable '%$variable' set to '$time'");
  } else {
    log_msg(LOG_WARN,
    "Operation '$key' does not exist, can't get window position");
  }

  return 5;
}

sub execute_setwpos_action {

  my($actionlist, $text, $i) = @_;
  my($timestamp, $conffile, $ruleid, $event);
  my($key, $oper, $ltime, $time, $time2);

  $timestamp = $actionlist->[$i+1];
  $conffile = $actionlist->[$i+2];
  $ruleid = $actionlist->[$i+3];
  $event = $actionlist->[$i+4];

  substitute_actionlist_var($timestamp, $text);
  substitute_actionlist_var($event, $text);

  $key = gen_key($conffile, $ruleid, $event);

  if ($timestamp !~ /^\s*0*([0-9]+)\s*$/) {
    log_msg(LOG_WARN,
    "Invalid timestamp '$timestamp' for moving the window of operation '$key'");
    return 5;
  }

  $timestamp = $1;
  $ltime = scalar(localtime($timestamp));

  log_msg(LOG_DEBUG,
  "Moving event correlation window to '$ltime' for operation '$key'");

  if (!exists($corr_list{$key})) {
    log_msg(LOG_WARN,
    "Operation '$key' does not exist, can't set window position");
    return 5;
  }

  $oper = $corr_list{$key};
  $time = $oper->{"Time"};
  $time2 = time();

  if (exists($oper->{"InitInProgress"})) {
    log_msg(LOG_WARN,
    "Operation '$key' is initializing, can't set window position");
    return 5;
  }

  if (exists($oper->{"DeleteInProgress"})) {
    log_msg(LOG_WARN,
    "Operation '$key' is terminating, can't set window position");
    return 5;
  }

  if ($timestamp < $time) {
    log_msg(LOG_WARN,
    "Can't move event correlation window backwards to '$ltime'");
    return 5;
  }

  if ($timestamp > $time2) {
    log_msg(LOG_WARN,
    "Can't move event correlation window into future to '$ltime'");
    return 5;
  }

  if ($timestamp == $time) {
    log_msg(LOG_DEBUG,
    "Event correlation window is already positioned at '$ltime'");
    return 5;
  }

  if ($oper->{"Type"} == SINGLE_W_THRESHOLD) {

    if (!exists($oper->{"SuppressMode"})) {
      update_times_swt($oper, $timestamp, 1);
      if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }
    } else {
      $oper->{"Time"} = $timestamp;
    }

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

    if (!exists($oper->{"2ndPass"})) {
      update_times_swt($oper, $timestamp, 1);
      if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }
    } else {
      update_times_swt($oper, $timestamp, 1);
    }

  } elsif ($oper->{"Type"} == EVENT_GROUP) {

    if (!exists($oper->{"SuppressMode"})) {
      update_times_eg($oper, $timestamp, 1);
      if (!scalar(@{$oper->{"AllTimes"}})) {
        $oper->{"DeleteInProgress"} = 1;
        execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
        delete $corr_list{$key};
      }
    } else {
      $oper->{"Time"} = $timestamp;
    }

  } else { $oper->{"Time"} = $timestamp; }

  if (!exists($corr_list{$key})) {
    log_msg(LOG_DEBUG,
    "Operation '$key' finished its work after window was moved");
  }

  return 5;
}

sub execute_assign_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $value);

  $variable = $actionlist->[$i+1];
  $value = $actionlist->[$i+2];

  substitute_actionlist_var($value, $text);

  log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'");

  $variables{$variable} = $value;

  return 3;
}

sub execute_assignsq_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $value);

  $variable = $actionlist->[$i+1];
  $value = $actionlist->[$i+2];

  substitute_actionlist_var($value, $text);

  $value =~ s/'/'\\''/g;
  $value = "'" . $value . "'";

  log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'");

  $variables{$variable} = $value;

  return 3;
}

sub execute_free_action {

  my($actionlist, undef, $i) = @_;
  my($variable);

  $variable = $actionlist->[$i+1];

  log_msg(LOG_DEBUG, "Freeing variable '%$variable'");

  delete $variables{$variable};

  return 2;
}

sub execute_eval_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $code);
  my(@retval, $evalok, $value);

  $variable = $actionlist->[$i+1];
  $code = $actionlist->[$i+2];

  substitute_actionlist_var($code, $text);

  log_msg(LOG_DEBUG,
          "Evaluating code '$code' and setting variable '%$variable'");

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

  if ($evalok) {

    foreach $value (@retval)  { if (!defined($value)) { $value = ""; } }

    if (scalar(@retval) > 1) {
      $value = join("\n", @retval);
      $variables{$variable} = $value;
      log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
    } elsif (scalar(@retval) == 1) {
      # this check is needed for cases when 'eval' returns a code reference,
      # because join() converts it to a string and 'call' actions will fail
      $variables{$variable} = $retval[0];
      log_msg(LOG_DEBUG, "Variable '%$variable' set to '$retval[0]'");
    } else {
      $variables{$variable} = undef;
      log_msg(LOG_DEBUG,
              "No value received for variable '%$variable', set to undef");
    }

  } else {
    log_msg(LOG_ERR, "Error evaluating code '$code':", $retval[0]);
  }

  return 3;
}

sub execute_call_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $code, @params);
  my($value, @retval);

  $variable = $actionlist->[$i+1];
  $code = $actionlist->[$i+2];
  @params = @{$actionlist->[$i+3]};

  log_msg(LOG_DEBUG,
          "Calling code '%$code->()' and setting variable '%$variable'");

  if (ref($variables{$code}) eq "CODE") {

    foreach $value (@params)  { substitute_actionlist_var($value, $text); }
    @retval = eval { $variables{$code}->(@params) };

    if ($@) {
      log_msg(LOG_ERR, "Code '%$code->()' runtime error:", $@);
    } else {

      if (scalar(@retval)) {
        foreach $value (@retval)  { if (!defined($value)) { $value = ""; } }
        $value = join("\n", @retval);
        $variables{$variable} = $value;
        log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
      } else {
        $variables{$variable} = undef;
        log_msg(LOG_DEBUG,
               "No value received for variable '%$variable', set to undef");
      }

    }

  } else {
    log_msg(LOG_WARN, "Variable '%$code' is not a code reference");
  }

  return 4;
}

sub execute_lcall_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $codeptr, $op, @params);
  my($value, @retval);

  $variable = $actionlist->[$i+1];
  $codeptr = $actionlist->[$i+2];
  @params = @{$actionlist->[$i+3]};
  $op = $actionlist->[$i+4];

  log_msg(LOG_DEBUG,
          "Calling code '$codeptr' and setting variable '%$variable'");

  foreach $value (@params)  { substitute_actionlist_var($value, $text); }

  if ($op) {
    foreach $value (@params) {
      $value = exists($pmatch_cache{$value})?$pmatch_cache{$value}:undef;
    }
  }

  @retval = eval { $codeptr->(@params) };

  if ($@) {
    log_msg(LOG_ERR, "Code '$codeptr' runtime error:", $@);
  } else {

    if (scalar(@retval)) {
      foreach $value (@retval)  { if (!defined($value)) { $value = ""; } }
      $value = join("\n", @retval);
      $variables{$variable} = $value;
      log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");
    } else {
      $variables{$variable} = undef;
      log_msg(LOG_DEBUG,
             "No value received for variable '%$variable', set to undef");
    }

  }

  return 5;
}

sub execute_rewrite_action {

  my($actionlist, $text, $i) = @_;
  my($count, $event, @event, $j, $buffer, $bufptr);

  $count = $actionlist->[$i+1];
  $event = $actionlist->[$i+2];

  substitute_actionlist_var($count, $text);
  substitute_actionlist_var($event, $text);

  if ($count =~ /^\s*0*([0-9]+)\s*$/) {

    $count = $1;

    @event = split(/\n/, $event);  # split returns empty list for "" or undef
    $j = scalar(@event);

    if (!$count) {
      if (!$j) {
        log_msg(LOG_WARN, "No data for rewriting input buffer");
        return 3;
      } else { $count = $j; }
    }

    if ($count > $bufsize)  { $count = $bufsize; }

    if ($j > $count) {
      @event = @event[0 .. $count - 1];
      $event = join("\n", @event);
    } elsif ($j < $count) {
      while ($j++ < $count)  { unshift @event, ""; }
      $event = join("\n", @event);
    }

    if ($jointbuf) {

      @input_buffer[$bufpos - $count + 1 .. $bufpos] = @event;
      log_msg(LOG_DEBUG, "Input buffer rewritten with '$event'");

    } elsif (defined($input_sources[$bufpos])) {

      # if the 'rewrite' action is not triggered by a pattern match but
      # rather by system clock, the source for last input line might be
      # no longer monitored (also, the elements of @input_sources list
      # are set to "" at program startup)

      if (exists($input_buffers{$input_sources[$bufpos]})) {
        $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
        $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
        @{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event;
        log_msg(LOG_DEBUG, "Input buffer of", $input_sources[$bufpos],
                           "rewritten with '$event'");
      } else {
        log_msg(LOG_WARN,
                "Can't rewrite the input buffer of non-configured source",
                $input_sources[$bufpos]);
      }

    } else {

      $buffer = $event_buffer{"Events"};
      $bufptr = $event_buffer{"BufPos"};
      @{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event;
      log_msg(LOG_DEBUG,
              "Input buffer of synthetic events rewritten with '$event'");
    }

  } else {
    log_msg(LOG_WARN, "Invalid linecount '$count', can't rewrite input buffer");
  }

  return 3;
}

sub execute_addinput_action {

  my($actionlist, $text, $i) = @_;
  my($file, $fpos, $context);
  my($time, $fh, $dev, $inode, $regfile);

  $file = $actionlist->[$i+1];
  $fpos = $actionlist->[$i+2];
  $context = $actionlist->[$i+3];

  substitute_actionlist_var($file, $text);
  substitute_actionlist_var($fpos, $text);
  substitute_actionlist_var($context, $text);

  log_msg(LOG_DEBUG, "Adding dynamic input file '" . $file .
          "' with context '" . $context . "' to the list of inputs");

  if (exists($dyninputfiles{$file})) {
    log_msg(LOG_WARN, "Dynamic input file '" . $file .
            "' already exists in the list of inputs, can't add");
    return 4;
  }

  if (exists($inputsrc{$file})) {
    log_msg(LOG_WARN, "Input file '" . $file .
            "' already exists in the list of inputs, can't add");
    return 4;
  }

  if ($fpos !~ /^\s*(-|[0-9]+)\s*$/i) {
    log_msg(LOG_WARN,
            "Invalid file offset '$fpos' specified for input file '$file'");
    return 4;
  }

  $fpos = $1;

  # open dynamic input file

  if ($fpos eq "-") {
    $fpos = -1;
    log_msg(LOG_DEBUG, "Opening input file '$file' and seeking EOF");
  } else {
    log_msg(LOG_DEBUG, "Opening input file '$file' and seeking offset '$fpos'");
  }

  ($fh, $dev, $inode, $regfile) = open_input_file($file, $fpos);

  $time = time();

  $inputsrc{$file} = { "fh" => $fh,
                       "open" => defined($fh),
                       "dev" => $dev,
                       "inode" => $inode,
                       "regfile" => $regfile,
                       "buffer" => "",
                       "scriptexec" => 0,
                       "checktime" => 0,
                       "lastopen" => $time,
                       "lastread" => $time,
                       "lines" => 0,
                       "context" => $context };

  # if the input file open failed because of the missing file, set the
  # "read_from_start" flag which enforces reading from the beginning
  # when the file will appear and another open will be attempted

  if (!defined($fh)  &&  $file ne "-"  &&  ! -e $file) {
    $inputsrc{$file}->{"read_from_start"} = 1;
  }

  # add dynamic input file to %dyninputfiles and @inputfiles global lists

  $dyninputfiles{$file} = $context;

  @inputfiles = sort keys %inputsrc;

  # with --nojointbuf command line option, set up a separate
  # input buffer for the dynamic input file

  if (!$jointbuf) {

    $input_buffers{$file} = {};
    $input_buffers{$file}->{"Events"} = [];
    $input_buffers{$file}->{"BufPos"} = 0;

    $input_buffers{$file}->{"BufPos"} =
      arrange_input_buffer($input_buffers{$file}->{"Events"},
                           $input_buffers{$file}->{"BufPos"});
  }

  return 4;
}

sub execute_dropinput_action {

  my($actionlist, $text, $i) = @_;
  my(@buf, $file, $j, $n);

  $file = $actionlist->[$i+1];

  substitute_actionlist_var($file, $text);

  log_msg(LOG_DEBUG,
          "Dropping dynamic input file '$file' from the list of inputs");

  if (exists($dyninputfiles{$file})) {

    # Drop dynamic input file from %dyninputfiles, %inputsrc and @inputfiles
    # global lists. Note that removing relevant entry from %inputsrc will
    # close the file (if it is open).

    delete $dyninputfiles{$file};

    delete $inputsrc{$file};

    @inputfiles = sort keys %inputsrc;

    # with --nojointbuf command line option, drop a separate
    # input buffer of the dynamic input file

    if (!$jointbuf)  { delete $input_buffers{$file}; }

    # remove all lines for dynamic input file from read buffer

    @buf = ();
    $n = scalar(@readbuffer);

    for ($j = 0; $j < $n; $j += 2) {
      if ($file eq $readbuffer[$j+1])  { next; }
      push @buf, $readbuffer[$j], $readbuffer[$j+1];
    }

    @readbuffer = @buf;

  } else {
    log_msg(LOG_WARN, "Dynamic input file '$file' not found, can't drop");
  }

  return 2;
}

sub execute_sigemul_action {

  my($actionlist, $text, $i) = @_;
  my($signal);

  $signal = $actionlist->[$i+1];

  substitute_actionlist_var($signal, $text);

  $signal = uc($signal);

  log_msg(LOG_DEBUG, "Emulating the arrival of '$signal' signal");

  if ($signal eq "HUP") {
    $refresh = 1;
    $sigreceived = 1;
  } elsif ($signal eq "ABRT") {
    $softrefresh = 1;
    $sigreceived = 1;
  } elsif ($signal eq "USR1") {
    $dumpdata = 1;
    $sigreceived = 1;
  } elsif ($signal eq "USR2") {
    $openlog = 1;
    $sigreceived = 1;
  } elsif ($signal eq "INT") {
    ++$debuglevelinc;
    $sigreceived = 1;
  } elsif ($signal eq "TERM") {
    $terminate{$$} = 1;
    $sigreceived = 1;
  } else {
    log_msg(LOG_WARN, "The arrival of '$signal' signal can't be emulated");
  }

  return 2;
}

sub execute_varset_action {

  my($actionlist, $text, $i) = @_;
  my($entry, $variable, $value);

  $variable = $actionlist->[$i+1];
  $entry = $actionlist->[$i+2];

  substitute_actionlist_var($entry, $text);

  log_msg(LOG_DEBUG,
          "Checking the presence of pattern match cache entry '$entry'");

  $value = (exists($pmatch_cache{$entry}))?1:0;
  $variables{$variable} = $value;

  log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'");

  return 3;
}

sub execute_if_action {

  my($actionlist, $text, $i) = @_;
  my($variable, $ret);

  $variable = $actionlist->[$i+1];
  $ret = 1;

  if (exists($variables{$variable}) && $variables{$variable}) {
    if (scalar(@{$actionlist->[$i+2]})) {
      $ret = execute_actionlist($actionlist->[$i+2], $text);
    }
  } else {
    if (scalar(@{$actionlist->[$i+3]})) {
      $ret = execute_actionlist($actionlist->[$i+3], $text);
    }
  }

  if ($ret != 1) { return $ret; }

  return 4;
}

sub execute_while_action {

  my($actionlist, $text, $i) = @_;
  my($variable);

  $variable = $actionlist->[$i+1];

  while (exists($variables{$variable}) && $variables{$variable}) {
    if (execute_actionlist($actionlist->[$i+2], $text) == -1) { last; }
  }

  return 3;
}

sub execute_break_action { return -1; }

sub execute_continue_action { return 0; }


# Parameters: par1 - reference to a list of actions
#             par2 - event description text
# Action: execute actions in a given action list.
#         Return 1 if the action list was fully executed;
#         return 0 if the execution was interrupted with the continue action;
#         return -1 if the execution was interrupted with the break action.

sub execute_actionlist {

  my($actionlist, $text) = @_;
  my($i, $j, $k);

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

  while ($i < $j) {
    $k = $execactionfunc[$actionlist->[$i]]->($actionlist, $text, $i);
    if ($k <= 0) { return $k; }
    $i += $k;
  }

  return 1;
}


#####################################################
# Functions related to processing of lists at runtime
#####################################################


# Parameters: par1 - context
# Action: check if context "par1" is valid at the moment and return 1
#         if it is, otherwise return 0. If context "par1" is found to
#         be stale but is still present in the context list, it will be
#         removed from there, and if it has an action list, the action
#         list will be executed.

sub valid_context {

  my($context) = $_[0];
  my($ref, $alias);

  if (exists($context_list{$context})) {

    # if the context has infinite lifetime or if its lifetime is not
    # exceeded, it is valid (TRUE) and return 1

    if (!$context_list{$context}->{"Window"})  { return 1; }

    if (time() - $context_list{$context}->{"Time"}
          <= $context_list{$context}->{"Window"})  { return 1; }

    # if the valid_context was called recursively and action-list-on-expire
    # is currently executing, the context is considered stale and return 0

    if (exists($context_list{$context}->{"DeleteInProgress"}))  { return 0; }

    log_msg(LOG_DEBUG, "Deleting stale context '$context'");

    # if the context is stale and its action-list-on-expire has not been
    # executed yet, execute it now

    if (scalar(@{$context_list{$context}->{"Action"}})) {

      # DeleteInProgress flag indicates that the action list execution is
      # in progress. The flag is used for two purposes:
      # 1) if this function is called recursively for the context, the flag
      #    prevents the action-list-on-expire from being executed again,
      # 2) the flag will temporarily disable all actions that remove either
      #    the context or any of its names (delete, obsolete, unalias) until
      #    the action-list-on-expire has completed

      $context_list{$context}->{"DeleteInProgress"} = 1;

      # if context name _THIS exists, the action list execution was triggered
      # by the action-list-on-expire of another context that is currently
      # referred by _THIS, therefore save the current value of _THIS

      if (exists($context_list{"_THIS"})) { $ref = $context_list{"_THIS"}; }
        else { $ref = undef; }

      # set _THIS to refer to the current context

      $context_list{"_THIS"} = $context_list{$context};

      # execute the action-list-on-expire

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

      # if context name _THIS was referring to another context previously,
      # restore the previous value, otherwise delete _THIS

      if (defined($ref)) { $context_list{"_THIS"} = $ref; }
        else { delete $context_list{"_THIS"}; }

    }

    # remove all names of the context from the list of contexts

    foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) {
      delete $context_list{$alias};
      log_msg(LOG_DEBUG, "Stale context '$alias' deleted");
    }

  }

  return 0;

}


# Parameters: par1 - reference to a context expression
# Action: calculate the truth value of the context expression par1;
#         return 1 if it is TRUE, 0 if it is FALSE, and undef if
#         the context expression is empty.

sub tval_context_expr {

  my($ref) = $_[0];
  my($i, $j, $left, @right);
  my($evalresult, $evalok, $retval);
  my($code, $func, $param, @params);

  $i = 0;
  $j = scalar(@{$ref});
  $left = undef;
  @right = ();

  while ($i < $j) {

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

      if (defined($left)) {
        push @right, OPERAND, $ref->[$i+1];
      } else {
        $left = valid_context($ref->[$i+1]);
      }

      $i += 2;

    }

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

      # if the second operand is present, negation belongs to it,
      # otherwise negate the value of the first operand

      if (scalar(@right)) {
        push @right, NEGATION;
      } else {
        $left = $left?0:1;
      }

      ++$i;

    }

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

      # the && operator has the short-circuiting capability and returns
      # the value of the last evaluated operand which is either 0 or 1

      $left = $left && tval_context_expr(\@right);
      @right = ();

      ++$i;

    }

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

      # the || operator has the short-circuiting capability and returns
      # the value of the last evaluated operand which is either 0 or 1

      $left = $left || tval_context_expr(\@right);
      @right = ();

      ++$i;

    }

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

      if (defined($left)) {
        push @right, EXPRESSION, $ref->[$i+1];
      } else {
        $left = tval_context_expr($ref->[$i+1]);
      }

      $i += 2;

    }

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

      if (defined($left)) {

        push @right, ECODE, $ref->[$i+1];

      } else {

        # if eval() for $code failed or returned false in boolean context
        # (undef, "", or 0), set $left to 0, otherwise set $left to 1

        $code = $ref->[$i+1];
        ($evalok, $evalresult) = SEC::call_eval($code, 0);

        if (!$evalok) {
          log_msg(LOG_ERR, "Error evaluating code '$code': $evalresult");
          $left = 0;
        } else {
          $left = $evalresult?1:0;
        }

      }

      $i += 2;

    }

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

      if (defined($left)) {

        push @right, CCODE, $ref->[$i+1], $ref->[$i+2];

      } else {

        # parameters for $func->() are copied into a new list @params, since
        # tval_context_expr() function could be called for the original
        # context expression definition (e.g., if the rule type is Calendar
        # or if the context expression is in []-brackets). Thus, passing
        # original parameter list to the end user would allow the user to
        # modify the original context definition. Furthermore, varset
        # parameters need to be replaced with corresponding references.

        @params = @{$ref->[$i+1]};
        $func = $ref->[$i+2];

        $retval = eval { $func->(@params) };

        # if function call failed or returned false in boolean context
        # (undef, "", or 0), set $left to 0, otherwise set $left to 1

        if ($@) {
          log_msg(LOG_ERR, "Context expression runtime error:", $@);
          $left = 0;
        } else {
          $left = $retval?1:0;
        }

      }

      $i += 3;

    }

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

      if (defined($left)) {

        push @right, CCODE2, $ref->[$i+1], $ref->[$i+2];

      } else {

        # parameters for $func->() are copied into a new list @params, since
        # tval_context_expr() function could be called for the original
        # context expression definition (e.g., if the rule type is Calendar
        # or if the context expression is in []-brackets). Thus, passing
        # original parameter list to the end user would allow the user to
        # modify the original context definition. Furthermore, varset
        # parameters need to be replaced with corresponding references.

        @params = @{$ref->[$i+1]};
        $func = $ref->[$i+2];

        foreach $param (@params) {
          $param = exists($pmatch_cache{$param})?$pmatch_cache{$param}:undef;
        }

        $retval = eval { $func->(@params) };

        # if function call failed or returned false in boolean context
        # (undef, "", or 0), set $left to 0, otherwise set $left to 1

        if ($@) {
          log_msg(LOG_ERR, "Context expression runtime error:", $@);
          $left = 0;
        } else {
          $left = $retval?1:0;
        }

      }

      $i += 3;

    }

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

      if (defined($left)) {
        push @right, VARSET, $ref->[$i+1];
      } else {
        $left = exists($pmatch_cache{$ref->[$i+1]})?1:0;
      }

      $i += 2;

    }

  }

  return $left;

}


# Parameters: par1 - number of lines the pattern matches (unused)
#             par2 - pattern (truth value)
#             par3 - match variable hash
# Action: if par2 is TRUE, set par3 to an empty hash and return 1,
#         otherwise return 0

sub match_tvalue {

  my(undef, $tvalue, $subst_ref) = @_;

  if ($tvalue)  { %{$subst_ref} = (); return 1; }
  return 0;
}


# Parameters: par1 - number of lines the pattern matches (unused)
#             par2 - pattern (cached match)
#             par3 - match variable hash
# Action: if par2 exists, set par3 to the match variable hash pointed by
#         par2 and return 1, otherwise return 0

sub match_cached {

  my(undef, $match, $subst_ref) = @_;

  if (exists($pmatch_cache{$match})) {
    %{$subst_ref} = %{$pmatch_cache{$match}};
    return 1;
  }

  return 0;
}


# Parameters: par1 - number of lines the pattern matches (unused)
#             par2 - pattern (cached match)
#             par3 - match variable hash
# Action: if par2 does not exist, set par3 to empty hash and return 1,
#         otherwise return 0

sub match_ncached {

  my(undef, $match, $subst_ref) = @_;

  if (!exists($pmatch_cache{$match}))  { %{$subst_ref} = (); return 1; }
  return 0;
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (string type)
#             par3 - match variable hash
# Action: take par1 last lines from input buffer and concatenate them to
#         form a single string. If par2 is a substring in the formed
#         string (both par1 and par2 can contain newlines), set par3 to
#         an empty hash and return 1, otherwise return 0.

sub match_substr {

  my($linecount, $substr, $subst_ref) = @_;
  my($line, $buffer, $bufptr);

  if ($bufsize == 1) {
    $line = $input_buffer[0];
  } elsif ($jointbuf) {
    $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  }

  if (index($line, $substr) != -1) {
    %{$subst_ref} = ();
    return 1;
  }
  return 0;
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (string type)
#             par3 - match variable hash (will be emptied)
# Action: take par1 last lines from input buffer and concatenate them to
#         form a single string. If par2 is not a substring in the formed
#         string (both par1 and par2 can contain newlines), set par3 to
#         an empty hash and return 1, otherwise return 0.

sub match_nsubstr {

  my($linecount, $substr, $subst_ref) = @_;
  my($line, $buffer, $bufptr);

  if ($bufsize == 1) {
    $line = $input_buffer[0];
  } elsif ($jointbuf) {
    $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  }

  if (index($line, $substr) == -1) {
    %{$subst_ref} = ();
    return 1;
  }
  return 0;
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (regular expression type)
#             par3 - match variable hash
#             par4 - variable map hash
# Action: take par1 last lines from input buffer and concatenate them to
#         form a single string. Match the formed string with regular
#         expression par2, and if par2 contains ()-operators, save
#         the substring matches to a hash par3. Additional variables are
#         then created in par3 according to map in par4. If specified with
#         the map par4, match variable values are cached. If the formed
#         string matched a regular expression, return 1, otherwise return 0

sub match_regexp {

  my($linecount, $regexp, $subst_ref, $varmap_ref) = @_;
  my($line, $buffer, $bufptr, @matches);

  if ($bufsize == 1) {
    $line = $input_buffer[0];
  } elsif ($jointbuf) {
    $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  }

  if (@matches = ($line =~ /$regexp/)) {

    # since a number of variables are only needed when there is a match,
    # declare them in relevant code block only for performance reasons
    my($match, $var, $i, $j, @celem);

    # overwrite the previous content of the match variable hash with named
    # substring matches from the regular expression
    %{$subst_ref} = %+;

    # add the $<number> match variables to the variable hash
    $i = 1;
    foreach $match (@matches)  { $subst_ref->{$i++} = $match; }

    # create the $0 variable
    $subst_ref->{"0"} = $line;

    # create the $+{_inputsrc} variable
    if ($bufsize == 1) {
      $subst_ref->{"_inputsrc"} =
        defined($input_sources[0])?$input_sources[0]:"synthetic";
    } elsif ($jointbuf) {
      $subst_ref->{"_inputsrc"} = join(" ", map(defined($_)?$_:"synthetic",
        @input_sources[$bufpos - $linecount + 1 .. $bufpos]));
    } else {
      $subst_ref->{"_inputsrc"} =
        defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic";
    }

    # create the $+{_intcontext} variable
    $subst_ref->{"_intcontext"} = $intcontextname;

    # add the $<name> match variables to the variable hash,
    # and add match variable values to pattern match cache
    if (scalar(%{$varmap_ref})) {
      $j = scalar(@matches);
      @celem = ();
      while (($var, $i) = each %{$varmap_ref}) {
        if (!defined($i))  { push @celem, $var; next; }
        $subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef;
      }
      foreach $var (@celem)  { $pmatch_cache{$var} = { %{$subst_ref} }; }
    }

    return 1;
  }

  return 0;
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (regular expression type)
#             par3 - match variable hash
# Action: take par1 last lines from input buffer and concatenate them to
#         form a single string. Match the formed string with regular
#         expression par2. If the formed string did not match a regular
#         expression, return 1, otherwise return 0

sub match_nregexp {

  my($linecount, $regexp, $subst_ref) = @_;
  my($line, $buffer, $bufptr, $source);

  if ($bufsize == 1) {
    $line = $input_buffer[0];
  } elsif ($jointbuf) {
    $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
  }

  if ($line !~ /$regexp/) {
    # erase the previous content of the match variable hash, and
    # create the $0, $+{_inputsrc} and $+{_intcontext} variables
    if ($bufsize == 1) {
      $source = defined($input_sources[0])?$input_sources[0]:"synthetic";
    } elsif ($jointbuf) {
      $source = join(" ", map(defined($_)?$_:"synthetic",
        @input_sources[$bufpos - $linecount + 1 .. $bufpos]));
    } else {
      $source =
        defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic";
    }
    %{$subst_ref} = ( "0" => $line,
                      "_inputsrc" => $source,
                      "_intcontext" => $intcontextname );
    return 1;
  }

  return 0;
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (perl function pointer)
#             par3 - match variable hash
#             par4 - variable map hash
# Action: take par1 last lines from input buffer with corresponding source
#         names, and pass them to the perl function par2->(). If the function
#         returned value(s), save them to hash par3 (and cache if specified
#         by map par4). If the function returned an empty list or returned
#         a single value FALSE, return 0, otherwise return 1

sub match_perlfunc {

  my($linecount, $codeptr, $subst_ref, $varmap_ref) = @_;
  my(@lines, @sources, $buffer, $bufptr);
  my(@matches, $size);

  if ($bufsize == 1) {
    $lines[0] = $input_buffer[0];
    $sources[0] = $input_sources[0];
  } elsif ($jointbuf) {
    @lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos];
    @sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos];
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
    $sources[0] = $input_sources[$bufpos];
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
    $sources[0] = undef;
  }

  # call the function and save its return values
  @matches = eval { $codeptr->(@lines, @sources) };

  # in the case of a function runtime error there is no match
  if ($@) {
    log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@);
    return 0;
  }

  # if the function returned no values or a single value which evaluates
  # FALSE in boolean context, there is no match, and return 0 immediately

  $size = scalar(@matches);

  if ($size == 0 || ($size == 1 && !$matches[0]))  { return 0; }

  # if the function produced a match, set match variables

  else {

    # since a number of variables are only needed when there is a match,
    # declare them in relevant code block only for performance reasons
    my($line, $source, $match, $var, $i, $j, @celem);

    # initialize the match variable hash
    %{$subst_ref} = ();

    # if the function returned a hash reference, create named match
    # variables from key=value pairs in the hash; otherwise add
    # function return values to the variable hash as numeric variables
    if ($size == 1 && ref($matches[0]) eq "HASH") {
      while ($var = each %{$matches[0]}) {
        $subst_ref->{$var} = $matches[0]->{$var};
      }
    } else {
      $i = 1;
      foreach $match (@matches)  { $subst_ref->{$i++} = $match; }
    }

    # create the $0, $+{_inputsrc} and $+{_intcontext} variables
    if ($bufsize == 1) {
      $line = $input_buffer[0];
      $source = defined($input_sources[0])?$input_sources[0]:"synthetic";
    } elsif ($jointbuf) {
      $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
      $source = join(" ", map(defined($_)?$_:"synthetic",
        @input_sources[$bufpos - $linecount + 1 .. $bufpos]));
    } elsif (defined($input_sources[$bufpos])) {
      $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
      $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
      $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
      $source = $input_sources[$bufpos];
    } else {
      $buffer = $event_buffer{"Events"};
      $bufptr = $event_buffer{"BufPos"};
      $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
      $source = "synthetic";
    }
    $subst_ref->{"0"} = $line;
    $subst_ref->{"_inputsrc"} = $source;
    $subst_ref->{"_intcontext"} = $intcontextname;

    # add the $<name> match variables to the variable hash,
    # and add match variable values to pattern match cache
    if (scalar(%{$varmap_ref})) {
      $j = scalar(@matches);
      @celem = ();
      while (($var, $i) = each %{$varmap_ref}) {
        if (!defined($i))  { push @celem, $var; next; }
        $subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef;
      }
      foreach $var (@celem)  { $pmatch_cache{$var} = { %{$subst_ref} }; }
    }

    return 1;
  }
}


# Parameters: par1 - number of lines the pattern matches
#             par2 - pattern (perl function pointer)
#             par3 - match variable hash
# Action: take par1 last lines from input buffer with corresponding source
#         names, and pass them to the perl function par2->().
#         If the function returned an empty list or returned
#         a single value FALSE, return 1, otherwise return 0

sub match_nperlfunc {

  my($linecount, $codeptr, $subst_ref) = @_;
  my(@lines, @sources, $buffer, $bufptr);
  my(@matches, $size, $line, $source);

  if ($bufsize == 1) {
    $lines[0] = $input_buffer[0];
    $sources[0] = $input_sources[0];
  } elsif ($jointbuf) {
    @lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos];
    @sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos];
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
    $sources[0] = $input_sources[$bufpos];
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr];
    $sources[0] = undef;
  }

  # call the function and save its return values
  @matches = eval { $codeptr->(@lines, @sources) };

  # in the case of a function runtime error there is no match
  if ($@) {
    log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@);
    return 0;
  }

  # if the function returned several values or a single value which evaluates
  # TRUE in boolean context, there is no match, and return 0 immediately

  $size = scalar(@matches);
  if ($size > 1 || ($size == 1 && $matches[0]))  { return 0; }

  # erase the previous content of the match variable hash, and
  # create the $0, $+{_inputsrc} and $+{_intcontext} variables
  if ($bufsize == 1) {
    $line = $input_buffer[0];
    $source = defined($input_sources[0])?$input_sources[0]:"synthetic";
  } elsif ($jointbuf) {
    $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]);
    $source = join(" ", map(defined($_)?$_:"synthetic",
      @input_sources[$bufpos - $linecount + 1 .. $bufpos]));
  } elsif (defined($input_sources[$bufpos])) {
    $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"};
    $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
    $source = $input_sources[$bufpos];
  } else {
    $buffer = $event_buffer{"Events"};
    $bufptr = $event_buffer{"BufPos"};
    $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]);
    $source = "synthetic";
  }
  %{$subst_ref} = ( "0" => $line,
                    "_inputsrc" => $source,
                    "_intcontext" => $intcontextname );

  return 1;
}


# Parameters: par1 - reference to a source action list
#             par2 - reference to a destination action list
#             par3 - pointer into the source and destination list
# Action: action from list par1 will be copied to par2; the function
#         will return an offset for advancing the pointer par3

sub copy_one_elem_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i];
  return 1;
}

sub copy_two_elem_action {

  my($src_ref, $dest_ref, $i) = @_;

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

sub copy_three_elem_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i];
  return 3;
}

sub copy_four_elem_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
                     $src_ref->[$i++], $src_ref->[$i];
  return 4;
}

sub copy_five_elem_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
                     $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i];
  return 5;
}

sub copy_cmdexec_spawnexec_action {

  my($src_ref, $dest_ref, $i) = @_;

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

sub copy_cspawnexec_pipeexec_reportexec_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [ @{$src_ref->[$i]} ];
  return 3;
}

sub copy_create_set_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++], [];
  copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
  return 4;
}

sub copy_call_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++],
                     $src_ref->[$i++], [ @{$src_ref->[$i]} ];
  return 4;
}

sub copy_lcall_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++],
                     [ @{$src_ref->[$i++]} ], $src_ref->[$i];
  return 5;
}

sub copy_if_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [], [];
  copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
  ++$i;
  copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
  return 4;
}

sub copy_while_action {

  my($src_ref, $dest_ref, $i) = @_;

  push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [];
  copy_actionlist($src_ref->[$i], $dest_ref->[$i]);
  return 3;
}


# Parameters: par1 - reference to a source action list
#             par2 - reference to a destination action list
# Action: action list par1 will be copied to par2

sub copy_actionlist {

  my($src_ref, $dest_ref) = @_;
  my($i, $j);

  @{$dest_ref} = ();
  $i = 0;
  $j = scalar(@{$src_ref});

  while ($i < $j) {
    $i += $actioncopyfunc[$src_ref->[$i]]->($src_ref, $dest_ref, $i);
  }

}


# Parameters: par1 - reference to a source context
#             par2 - reference to a destination context
# Action: context par1 will be copied to par2

sub copy_context {

  my($src_ref, $dest_ref) = @_;
  my($i, $j);

  @{$dest_ref} = ();
  $i = 0;
  $j = scalar(@{$src_ref});

  while ($i < $j) {

    if ($src_ref->[$i] == OPERAND) {
      push @{$dest_ref}, OPERAND, $src_ref->[$i+1];
      $i += 2;
    }

    elsif ($src_ref->[$i] == EXPRESSION) {
      push @{$dest_ref}, EXPRESSION, [];
      copy_context($src_ref->[$i+1], $dest_ref->[$i+1]);
      $i += 2;
    }

    elsif ($src_ref->[$i] == ECODE) {
      push @{$dest_ref}, ECODE, $src_ref->[$i+1];
      $i += 2;
    }

    elsif ($src_ref->[$i] == CCODE) {
      push @{$dest_ref}, CCODE, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2];
      $i += 3;
    }

    elsif ($src_ref->[$i] == CCODE2) {
      push @{$dest_ref}, CCODE2, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2];
      $i += 3;
    }

    elsif ($src_ref->[$i] == VARSET) {
      push @{$dest_ref}, VARSET, $src_ref->[$i+1];
      $i += 2;
    }

    else {
      push @{$dest_ref}, $src_ref->[$i];
      ++$i;
    }

  }

}


# Parameters: par1 - reference to the hash of match variables
#             par2, par3, .. - strings that will go through
#                              the substitution procedure
#             par n - token that special variables start with
# Action: Strings par2, par3, .. will be searched for special variables
#         (like $0, $1, $2, ..) that will be replaced with corresponding
#         values from hash par1. If the token symbol is followed by
#         another token symbol, these two symbols will be replaced by
#         a single token (e.g., $$ -> $).

sub subst_string {

  my($subst_ref) = shift @_;
  my($token) = pop @_;
  my($token2, $msg);

  $token2 = quotemeta($token);

  # variable names in variable map definitions must begin with a letter, but
  # since named match variables defined in Perl regular expressions can begin
  # both with a letter and underscore, both cases are handled below

  foreach $msg (@_) {

    if (index($msg, $token) == -1)  { next; }

    elsif (index($msg, "$token:{") == -1) {

      $msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}|
                          \+\{([[:alpha:]_][\w!]*|[0-9]+)\})/
      !defined($+)?$token:(defined($subst_ref->{$+})?$subst_ref->{$+}:"")/egx;

    } else {

      # calling defined($pmatch_cache{$4}->{$+}) will create $pmatch_cache{$4}
      # if it doesn't exist, thus exists($pmatch_cache{$4}) is called first

      $msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}|
                          \+\{([[:alpha:]_][\w!]*|[0-9]+)\}|
                          :\{([[:alpha:]]\w*):([[:alpha:]_][\w!]*|[0-9]+)\})/
      !defined($+)?$token:
          (!defined($4)?(defined($subst_ref->{$+})?$subst_ref->{$+}:""):
            ((exists($pmatch_cache{$4}) && defined($pmatch_cache{$4}->{$+}))?
              $pmatch_cache{$4}->{$+}:""))/egx;
    }
  }

}


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

sub subst_regexp {

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

  %subst_modified = %{$subst_ref};

  while ($subst = each %subst_modified) {
    if (defined($subst_modified{$subst})) {
      $subst_modified{$subst} = quotemeta($subst_modified{$subst});
    }
  }

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

}


# Parameters: par1 - reference to the array of replacements
#             par2 - reference to a context expression
#             par3 - token that special variables start with
# Action: Context expression par2 will be searched for special variables
#         (like $1, $2, ..) that will be replaced with 1st, 2nd, .. element
#         from array par1

sub subst_context {

  my($subst_ref, $ref, $token) = @_;
  my($i, $j);

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

  while ($i < $j) {

    if ($ref->[$i] == OPERAND || $ref->[$i] == VARSET
                              || $ref->[$i] == ECODE) {
      subst_string($subst_ref, $ref->[$i+1], $token);
      $i += 2;
    }

    elsif ($ref->[$i] == EXPRESSION) {
      subst_context($subst_ref, $ref->[$i+1], $token);
      $i += 2;
    }

    elsif ($ref->[$i] == CCODE || $ref->[$i] == CCODE2) {
      subst_string($subst_ref, @{$ref->[$i+1]}, $token);
      $i += 3;
    }

    else { ++$i; }

  }

}


# Parameters: par1 - reference to the array of replacements
#             par2 - reference to the array of replacements (originals)
#             par3 - reference to action list
#             par4 - token that special variables start with
#             par5 - pointer into the action list
# Action: action from list par3 will be searched for special variables
#         (like $1, $2, ..) that will be replaced with 1st, 2nd, ..
#         element from array par1 or par2; the function will return an offset
#         for advancing the pointer par5

sub subst_none_break_continue { return 1; }

sub subst_free { return 2; }

sub subst_two_elem_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  return 2;
}

sub subst_three_elem_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  subst_string($subst_ref, $actionlist->[$i+2], $token);
  return 3;
}

sub subst_four_elem_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  subst_string($subst_ref, $actionlist->[$i+2], $token);
  subst_string($subst_ref, $actionlist->[$i+3], $token);
  return 4;
}

sub subst_cmdexec_spawnexec_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, @{$actionlist->[$i+1]}, $token);
  return 2;
}

sub subst_cspawnexec_pipeexec_reportexec_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  subst_string($subst_ref, @{$actionlist->[$i+2]}, $token);
  return 3;
}

sub subst_create_set_action {

  my($subst_ref, $subst_orig_ref, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  subst_string($subst_ref, $actionlist->[$i+2], $token);
  subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token);
  return 4;
}

sub subst_copy_empty_etc_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  return 3;
}

sub subst_event_assign_etc_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+2], $token);
  return 3;
}

sub subst_reset_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+3], $token);
  return 4;
}

sub subst_getwpos_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+4], $token);
  return 5;
}

sub subst_setwpos_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, $actionlist->[$i+1], $token);
  subst_string($subst_ref, $actionlist->[$i+4], $token);
  return 5;
}

sub subst_call_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, @{$actionlist->[$i+3]}, $token);
  return 4;
}

sub subst_lcall_action {

  my($subst_ref, undef, $actionlist, $token, $i) = @_;

  subst_string($subst_ref, @{$actionlist->[$i+3]}, $token);
  return 5;
}

sub subst_if_action {

  my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_;

  subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token);
  subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token);
  return 4;
}

sub subst_while_action {

  my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_;

  subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token);
  return 3;
}


# Parameters: par1 - reference to the array of replacements
#             par2 - reference to action list
#             par3 - token that special variables start with
# Action: action list par2 will be searched for special variables
#         (like $1, $2, ..) that will be replaced with 1st, 2nd, ..
#         element from array par1

sub subst_actionlist {

  my($subst_ref, $actionlist, $token) = @_;
  my($subst, %subst_modified);
  my($i, $j);

  # mask %-signs in substitutions, in order to prevent incorrect
  # %<alnum>-variable interpretations

  %subst_modified = %{$subst_ref};

  while ($subst = each %subst_modified) {
    if (defined($subst_modified{$subst})) {
      $subst_modified{$subst} =~ s/%/%%/g;
    }
  }

  # process the action list

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

  while ($i < $j) {
    $i += $actionsubstfunc[$actionlist->[$i]]->(\%subst_modified,
                                                $subst_ref,
                                                $actionlist,
                                                $token, $i);
  }

}


# Parameters: par1 - reference to an operation from list %corr_list
#             par2 - timestamp
#             par3 - flag (optional)
# Action: search the list of event occurrence times of the SingleWithThreshold
#         or SingleWith2Thresholds operation which is pointed by par1;
#         list elements which are older than par2 will be removed.
#         If flag par3 is set, the beginning of the event correlation
#         window for operation par1 will be set to par2; otherwise it will
#         be set to the earliest remaining occurrence time in the list.

sub update_times_swt {

  my($oper, $time, $flag) = @_;
  my($tlist);

  $tlist = $oper->{"Times"};

  while (scalar(@{$tlist})) {
    if ($tlist->[0] >= $time)  { last; }
    shift @{$tlist};
  }

  if (!defined($flag) && scalar(@{$tlist})) {
    $oper->{"Time"} = $tlist->[0];
  } else {
    $oper->{"Time"} = $time;
  }

}


# Parameters: par1 - reference to an operation from list %corr_list
#             par2 - timestamp
#             par3 - flag (optional)
# Action: search the list of event occurrence times of the EventGroup
#         operation which is pointed by par1; list elements which are older
#         than par2 will be removed.
#         If flag par3 is set, the beginning of the event correlation
#         window for operation par1 will be set to par2; otherwise it will
#         be set to the earliest remaining occurrence time in the list.

sub update_times_eg {

  my($oper, $time, $flag) = @_;
  my($tlist, $i);

  $tlist = $oper->{"AllTimes"};

  while (scalar(@{$tlist})) {
    if ($tlist->[0]->[0] >= $time)  { last; }
    $i = $tlist->[0]->[1];
    shift @{$oper->{"TimesList"}->[$i]};
    shift @{$tlist};
  }

  if (!defined($flag) && scalar(@{$tlist})) {
    $oper->{"Time"} = $tlist->[0]->[0];
  } else {
    $oper->{"Time"} = $time;
  }

}


# Parameters: par1 - event group string
#             par2 - event group matching pattern
# Action: match event group string par1 with event group pattern par2;
#         return 1 if match was found, otherwise return 0

sub match_eventgroup_substr {

  my($string, $substr) = @_;

  if (index($string, $substr) != -1)  { return 1; }
  return 0;
}


sub match_eventgroup_nsubstr {

  my($string, $substr) = @_;

  if (index($string, $substr) == -1)  { return 1; }
  return 0;
}


sub match_eventgroup_regexp {

  my($string, $regexp) = @_;

  if ($string =~ /$regexp/)  { return 1; }
  return 0;
}


sub match_eventgroup_nregexp {

  my($string, $regexp) = @_;

  if ($string !~ /$regexp/)  { return 1; }
  return 0;
}


sub match_eventgroup_perlfunc {

  my($string, $codeptr) = @_;
  my($retval);

  # call the function and save its return value;
  # in the case of a function runtime error there is no match

  $retval = eval { $codeptr->($string) };

  if ($@) {
    log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@);
    return 0;
  }

  # if the function returned a value which evaluates true in boolean
  # context (neither undef, nor "", nor 0), return 1, otherwise return 0

  if ($retval)  { return 1; }
  return 0;
}


sub match_eventgroup_nperlfunc {

  my($string, $codeptr) = @_;
  my($retval);

  # call the function and save its return value;
  # in the case of a function runtime error there is no match

  $retval = eval { $codeptr->($string) };

  if ($@) {
    log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@);
    return 0;
  }

  # if the function returned a value which evaluates false in boolean
  # context (undef, "", or 0), return 1, otherwise return 0

  if (!$retval)  { return 1; }
  return 0;
}


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

sub gen_key {
  return join(SEPARATOR, @_);
}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
# Action: process the Single rule after a match has been found

sub process_single_rule {

  my($rule, $subst) = @_;
  my($desc, $action);

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

  if (scalar(%{$subst})) {

    if (exists($rule->{"ActVolat"})) {
      $action = [];
      copy_actionlist($rule->{"Action"}, $action);
      subst_actionlist($subst, $action, '$');
    } else { $action = $rule->{"Action"}; }

    subst_string($subst, $desc, '$');

  } else { $action = $rule->{"Action"}; }

  execute_actionlist($action, $desc);

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
# Action: process the SingleWithScript rule after a match has been found

sub process_singlewithscript_rule {

  my($rule, $subst) = @_;
  my(@script, $script, $shell, $desc, $pid);
  my($action, $action2);

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

  # check if the command line provided with the 'script' field has to be
  # executed without shell interpretation, and if yes, copy the command
  # line arguments into local array @script

  if (ref($rule->{"Script"}) eq "ARRAY") {
    @script = @{$rule->{"Script"}};
    $shell = 0;
  } else {
    $script = $rule->{"Script"};
    $shell = 1;
  }

  if (scalar(%{$subst})) {

    if (exists($rule->{"ActVolat"})) {
      $action = [];
      copy_actionlist($rule->{"Action"}, $action);
      subst_actionlist($subst, $action, '$');
    } else { $action = $rule->{"Action"}; }

    if (exists($rule->{"ActVolat2"})) {
      $action2 = [];
      copy_actionlist($rule->{"Action2"}, $action2);
      subst_actionlist($subst, $action2, '$');
    } else { $action2 = $rule->{"Action2"}; }

    if ($shell) {
      subst_string($subst, $desc, $script, '$');
    } else {
      subst_string($subst, $desc, @script, '$');
    }

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

  # if the command line provided with the 'script' field has to be
  # executed without shell interpretation, pass a reference to the
  # array @script with command line arguments to pipe_cmd() function

  if ($shell) {
    $pid = pipe_cmd($script, \%context_list);
  } else {
    $pid = pipe_cmd(\@script, \%context_list);
  }

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

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
# Action: process the SingleWithSuppress rule after a match has been found

sub process_singlewithsuppress_rule {

  my($rule, $subst, $conffile) = @_;
  my($desc, $key, $time, $action);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

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

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

    if (scalar(%{$subst}) && exists($rule->{"ActVolat"})) {
      $action = [];
      copy_actionlist($rule->{"Action"}, $action);
      subst_actionlist($subst, $action, '$');
    } else { $action = $rule->{"Action"}; }

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

    execute_actionlist($action, $desc);
  }

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
# Action: process the Pair rule after a match has been found

sub process_pair_rule {

  my($rule, $subst, $conffile) = @_;
  my($desc, $key, $time, $temppat, $pattern2, $desc2);
  my($action, $action2, $context2, $sub, $act2copied);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

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

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

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

    if (scalar(%{$subst})) {

      if (exists($rule->{"ActVolat"})) {
        $action = [];
        copy_actionlist($rule->{"Action"}, $action);
        subst_actionlist($subst, $action, '$');
      } else { $action = $rule->{"Action"}; }

      if (exists($rule->{"ActVolat2"})) {
        $action2 = [];
        copy_actionlist($rule->{"Action2"}, $action2);
        $act2copied = 1;
      } else { $action2 = $rule->{"Action2"}; }

      if (exists($rule->{"ContVolat2"})) {
        $context2 = [];
        copy_context($rule->{"Context2"}, $context2);
      } else { $context2 = $rule->{"Context2"}; }

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

        if (exists($rule->{"Pat2NotCompiled"})) {

          subst_regexp($subst, $pattern2, '$');
          $temppat = $pattern2;
          $pattern2 = eval { qr/$pattern2/ };

          if ($@) {
            log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for Pair rule:", $@);
            log_msg(LOG_ERR, "Can't start Pair event correlation operation with the key '$key'");
            return;
          }
        }

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

        while ($sub = each %{$subst}) {
          if (defined($subst->{$sub}))  { $subst->{$sub} =~ s/\$/\$\$/g; }
        }

        subst_string($subst, $desc2, '%');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '%');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '%');
        }

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

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

        while ($sub = each %{$subst}) {
          if (defined($subst->{$sub}))  { $subst->{$sub} =~ s/\$/\$\$/g; }
        }

        subst_string($subst, $desc2, '%');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '%');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '%');
        }

      } elsif ($rule->{"PatType2"} == SUBSTR  ||
               $rule->{"PatType2"} == NSUBSTR) {

        subst_string($subst, $pattern2, $desc2, '$');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '$');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '$');
        }

      } elsif ($rule->{"PatType2"} == NCACHED  ||
               $rule->{"PatType2"} == TVALUE) {

        subst_string($subst, $desc2, '$');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '$');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '$');
        }
      }

    } else {

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

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

    if (defined($act2copied))  { $corr_list{$key}->{"Act2Copied"} = 1; }
    $rule->{"Operations"}->{$key} = $corr_list{$key};

    execute_actionlist($action, $desc);
  }

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
# Action: process the PairWithWindow rule after a match has been found

sub process_pairwithwindow_rule {

  my($rule, $subst, $conffile) = @_;
  my($desc, $key, $time, $temppat, $pattern2, $desc2);
  my($action, $action2, $context2, $sub, $act2copied);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

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

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

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

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

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

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

    if (scalar(%{$subst})) {

      if (exists($rule->{"ActVolat"})) {
        $action = [];
        copy_actionlist($rule->{"Action"}, $action);
        subst_actionlist($subst, $action, '$');
      } else { $action = $rule->{"Action"}; }

      if (exists($rule->{"ActVolat2"})) {
        $action2 = [];
        copy_actionlist($rule->{"Action2"}, $action2);
        $act2copied = 1;
      } else { $action2 = $rule->{"Action2"}; }

      if (exists($rule->{"ContVolat2"})) {
        $context2 = [];
        copy_context($rule->{"Context2"}, $context2);
      } else { $context2 = $rule->{"Context2"}; }
      if ($rule->{"PatType2"} == REGEXP  ||
          $rule->{"PatType2"} == NREGEXP) {

        if (exists($rule->{"Pat2NotCompiled"})) {

          subst_regexp($subst, $pattern2, '$');
          $temppat = $pattern2;
          $pattern2 = eval { qr/$pattern2/ };

          if ($@) {
            log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for PairWithWindow rule:", $@);
            log_msg(LOG_ERR, "Can't start PairWithWindow event correlation operation with the key '$key'");
            return;
          }
        }

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

        while ($sub = each %{$subst}) {
          if (defined($subst->{$sub}))  { $subst->{$sub} =~ s/\$/\$\$/g; }
        }

        subst_string($subst, $desc2, '%');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '%');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '%');
        }

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

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

        while ($sub = each %{$subst}) {
          if (defined($subst->{$sub}))  { $subst->{$sub} =~ s/\$/\$\$/g; }
        }

        subst_string($subst, $desc2, '%');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '%');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '%');
        }

      } elsif ($rule->{"PatType2"} == SUBSTR  ||
               $rule->{"PatType2"} == NSUBSTR) {

        subst_string($subst, $pattern2, $desc2, '$');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '$');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '$');
        }

      } elsif ($rule->{"PatType2"} == NCACHED  ||
               $rule->{"PatType2"} == TVALUE) {

        subst_string($subst, $desc2, '$');

        if (exists($rule->{"ActVolat2"})) {
          subst_actionlist($subst, $action2, '$');
        }
        if (exists($rule->{"ContVolat2"})) {
          subst_context($subst, $context2, '$');
        }
      }

    } else {

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

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

    if (defined($act2copied))  { $corr_list{$key}->{"Act2Copied"} = 1; }
    $rule->{"Operations"}->{$key} = $corr_list{$key};
  }

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
# Action: process the SingleWithThreshold rule after a match has been found

sub process_singlewiththreshold_rule {

  my($rule, $subst, $conffile) = @_;
  my($desc, $key, $time, $oper, $action, $action2);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

  # if there exists event correlation operation for the key and its window
  # has expired, slide the window forward or terminate the operation

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

    $oper = $corr_list{$key};

    if (!exists($oper->{"SuppressMode"})) {

      # if the operation is not in event suppressing mode, slide the window
      # forward; if no events remain in the window, terminate the operation

      update_times_swt($oper, $time - $oper->{"Window"});
      if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }

    } else {

      # if the operation is in event suppressing mode, terminate it

      execute_actionlist($oper->{"Action2"}, $desc);
      delete $corr_list{$key};
    }
  }

  # if there was no event correlation operation for the key when this
  # function was called (or the operation was terminated previously
  # within this function), start the new operation

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

    if (scalar(%{$subst})) {

      if (exists($rule->{"ActVolat"})) {
        $action = [];
        copy_actionlist($rule->{"Action"}, $action);
        subst_actionlist($subst, $action, '$');
      } else { $action = $rule->{"Action"}; }

      if (exists($rule->{"ActVolat2"})) {
        $action2 = [];
        copy_actionlist($rule->{"Action2"}, $action2);
        subst_actionlist($subst, $action2, '$');
      } else { $action2 = $rule->{"Action2"}; }

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

    $corr_list{$key} = { "StartTime" => $time,
                         "Time" => $time,
                         "Type" => $rule->{"Type"},
                         "File" => $conffile,
                         "ID" => $rule->{"ID"},
                         "Window" => $rule->{"Window"},
                         "Times" => [],
                         "Desc" => $desc,
                         "Action" => $action,
                         "Action2" => $action2 };
  }

  $oper = $corr_list{$key};

  # if the operation is in event suppressing mode, return
  if (exists($oper->{"SuppressMode"}))  { return; }

  # record data about the current event into occurrence time list
  push @{$oper->{"Times"}}, $time;

  # return if the number of events in the list is below threshold
  if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"})  { return; }

  # if the threshold condition is met, go to suppressing mode
  $oper->{"SuppressMode"} = 1;

  # execute the rule action (if setwpos action gets executed for
  # the operation, it will appear in suppressing mode)
  execute_actionlist($oper->{"Action"}, $desc);

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
# Action: process the SingleWith2Thresholds rule after a match has been found

sub process_singlewith2thresholds_rule {

  my($rule, $subst, $conffile) = @_;
  my($desc, $key, $time, $oper, $desc2, $action, $action2);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

  # if there exists event correlation operation for the key and its window
  # has expired, slide the window forward or terminate the operation

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

    $oper = $corr_list{$key};

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

      # if the operation is in rising threshold mode, slide the window
      # forward; if no events remain in the window, terminate the operation

      update_times_swt($oper, $time - $oper->{"Window"});
      if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }

    } else {

      # if the operation is in falling threshold mode, terminate it

      execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
      delete $corr_list{$key};
    }
  }

  # if there was no event correlation operation for the key when this
  # function was called (or the operation was terminated previously
  # within this function), start the new operation

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

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

    if (scalar(%{$subst})) {

      if (exists($rule->{"ActVolat"})) {
        $action = [];
        copy_actionlist($rule->{"Action"}, $action);
        subst_actionlist($subst, $action, '$');
      } else { $action = $rule->{"Action"}; }

      if (exists($rule->{"ActVolat2"})) {
        $action2 = [];
        copy_actionlist($rule->{"Action2"}, $action2);
        subst_actionlist($subst, $action2, '$');
      } else { $action2 = $rule->{"Action2"}; }

      subst_string($subst, $desc2, '$');

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

    $corr_list{$key} = { "StartTime" => $time,
                         "Time" => $time,
                         "Type" => $rule->{"Type"},
                         "File" => $conffile,
                         "ID" => $rule->{"ID"},
                         "Window" => $rule->{"Window"},
                         "Times" => [],
                         "Desc" => $desc,
                         "Action" => $action,
                         "Desc2" => $desc2,
                         "Action2" => $action2 };
  }

  $oper = $corr_list{$key};

  # record data about the current event into occurrence time list
  push @{$oper->{"Times"}}, $time;

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

    # the operation is in rising threshold mode:
    # return if the number of events in the list is below threshold
    if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"})  { return; }

    # if the threshold condition is met, go to falling threshold mode

    $oper->{"2ndPass"} = 1;
    $oper->{"Time"} = $time;
    $oper->{"Window"} = $rule->{"Window2"};
    @{$oper->{"Times"}} = ();

    # execute the rule action (if setwpos action gets executed for
    # the operation, it will appear in falling threshold mode)
    execute_actionlist($oper->{"Action"}, $desc);

  } else {

    # the operation is in falling threshold mode:
    # return if the number of events in the list is not greater than threshold
    if (scalar(@{$oper->{"Times"}}) <= $rule->{"Threshold2"})  { return; }

    # if the threshold condition is met, remove the first occurrence time
    # from the time list, and move the window to the second occurrence time
    # time (if the list became empty after first element was removed , i.e.
    # the threshold is 0, move the window to current time)

    shift @{$oper->{"Times"}};

    if (scalar(@{$oper->{"Times"}})) {
      $oper->{"Time"} = $oper->{"Times"}->[0];
    } else {
      $oper->{"Time"} = $time;
    }
  }

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
#             par4 - the number of the pattern that has produced the match
# Action: process the EventGroup rule after a match has been found

sub process_eventgroup_rule {

  my($rule, $subst, $conffile, $index) = @_;
  my($desc, $key, $time, $oper, $i, $egrpstring);
  my($initaction, $slideaction, $endaction, $countaction, $action);

  $desc = $rule->{"Desc"};
  if (scalar(%{$subst}))  { subst_string($subst, $desc, '$'); }

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

  # if there exists event correlation operation for the key and its window
  # has expired, slide the window forward or terminate the operation

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

    $oper = $corr_list{$key};

    if (!exists($oper->{"SuppressMode"})) {

      # if the operation is not in event suppressing mode, slide the window
      # forward; if no events remain in the window, terminate the operation

      update_times_eg($oper, $time - $oper->{"Window"});

      if (!scalar(@{$oper->{"AllTimes"}})) {
        $oper->{"DeleteInProgress"} = 1;
        execute_actionlist($oper->{"EndAction"}, $desc);
        delete $corr_list{$key};
      } else {
        execute_actionlist($oper->{"SlideAction"}, $desc);
      }

    } else {

      # if the operation is in event suppressing mode, terminate it

      $oper->{"DeleteInProgress"} = 1;
      execute_actionlist($oper->{"EndAction"}, $desc);
      delete $corr_list{$key};
    }
  }

  # if there was no event correlation operation for the key when this
  # function was called (or the operation was terminated previously
  # within this function), start the new operation

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

    if (scalar(%{$subst})) {

      if (exists($rule->{"InitActVolat"})) {
        $initaction = [];
        copy_actionlist($rule->{"InitAction"}, $initaction);
        subst_actionlist($subst, $initaction, '$');
      } else { $initaction = $rule->{"InitAction"}; }

      if (exists($rule->{"SlideActVolat"})) {
        $slideaction = [];
        copy_actionlist($rule->{"SlideAction"}, $slideaction);
        subst_actionlist($subst, $slideaction, '$');
      } else { $slideaction = $rule->{"SlideAction"}; }

      if (exists($rule->{"EndActVolat"})) {
        $endaction = [];
        copy_actionlist($rule->{"EndAction"}, $endaction);
        subst_actionlist($subst, $endaction, '$');
      } else { $endaction = $rule->{"EndAction"}; }

      if (exists($rule->{"ActVolat"})) {
        $action = [];
        copy_actionlist($rule->{"Action"}, $action);
        subst_actionlist($subst, $action, '$');
      } else { $action = $rule->{"Action"}; }

    } else {

      $initaction = $rule->{"InitAction"};
      $slideaction = $rule->{"SlideAction"};
      $endaction = $rule->{"EndAction"};
      $action = $rule->{"Action"};
    }

    $corr_list{$key} = { "StartTime" => $time,
                         "Time" => $time,
                         "Type" => $rule->{"Type"},
                         "File" => $conffile,
                         "ID" => $rule->{"ID"},
                         "Window" => $rule->{"Window"},
                         "AllTimes" => [],
                         "Desc" => $desc,
                         "InitAction" => $initaction,
                         "SlideAction" => $slideaction,
                         "EndAction" => $endaction,
                         "Action" => $action };

    for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
      $corr_list{$key}->{"TimesList"}->[$i] = [];
    }

    $corr_list{$key}->{"InitInProgress"} = 1;

    execute_actionlist($initaction, $desc);

    # if the init action terminated the operation, return
    if (!exists($corr_list{$key}))  { return; }

    delete $corr_list{$key}->{"InitInProgress"};
  }

  $oper = $corr_list{$key};

  # record data about the current event into occurrence time lists (done before count
  # action is executed, so that the action would see the current event in the window)

  push @{$oper->{"AllTimes"}}, [$time, $index];
  push @{$oper->{"TimesList"}->[$index]}, $time;

  # execute count action for the given event type

  if (scalar(%{$subst}) && exists($rule->{"CountActVolatList"}->{$index})) {
    $countaction = [];
    copy_actionlist($rule->{"CountActionList"}->[$index], $countaction);
    subst_actionlist($subst, $countaction, '$');
  } else { $countaction = $rule->{"CountActionList"}->[$index]; }

  execute_actionlist($countaction, $desc);

  # if the count action terminated the operation, return
  if (!exists($corr_list{$key}))  { return; }

  # if the operation is in event suppressing mode, return
  if (exists($oper->{"SuppressMode"}))  { return; }

  # check threshold conditions for all event types - if for some event type
  # the number of events is below threshold, return

  for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {
    if (scalar(@{$oper->{"TimesList"}->[$i]}) <
        $rule->{"ThresholdList"}->[$i])  { return; }
  }

  # if event group pattern has been provided by the rule, create an event
  # group string and match it with event group pattern; if the pattern is
  # not matching, return

  if (exists($rule->{"EGrpPattern"})) {

    $egrpstring = join(" ", map { $_->[1] + 1 } @{$oper->{"AllTimes"}});

    if (!$matchegrpfunc[$rule->{"EGrpPatType"}]->($egrpstring,
                                                  $rule->{"EGrpPattern"})) {
      return 0;
    }
  }

  # if all threshold conditions are met, go to suppressing mode if specified by
  # the rule, and execute the rule action (if setwpos action gets executed for
  # the operation, it will appear in suppressing mode if specified by the rule)

  if (!exists($rule->{"MultipleActions"}))  { $oper->{"SuppressMode"} = 1; }

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

}


# Parameters: par1 - reference to the rule definition
#             par2 - reference to the hash of match values
#             par3 - name of the configuration file
#             par4 - trace hash for detecting loops during recursive calls
# Action: process the Jump rule after a match has been found. If the
#         processing of rule file sets referenced by Jump is terminated by
#         the continue*=EndMatch statement, return 1, otherwise return 0.

sub process_jump_rule {

  my($rule, $subst, $conffile, $trace) = @_;
  my($cfsetlist, $cfset, $cf);

  if (!exists($rule->{"CFSet"})) { return 0; }

  if (!defined($trace))  { $trace = {}; }

  if (!exists($rule->{"ConstSet"}) && scalar(%{$subst})) {
    $cfsetlist = [ @{$rule->{"CFSet"}} ];
    subst_string($subst, @{$cfsetlist}, '$');
  } else {
    $cfsetlist = $rule->{"CFSet"};
  }

  foreach $cfset (@{$cfsetlist}) {

    if (exists($trace->{$cfset})) {
      log_msg(LOG_WARN,
      "Can't jump to fileset '$cfset' from $conffile, loop detected");
      next;
    }

    if (!exists($cfset2cfile{$cfset})) {
      log_msg(LOG_WARN,
      "Can't jump to fileset '$cfset' from $conffile, set does not exist");
      next;
    }

    # process the files in the set by calling process_rules() recursively;
    # the set name is recorded to %trace, in order to detect loops;
    # if the processing in the rule file set is terminated by the
    # continue*=EndMatch statement, end processing and return 1

    $trace->{$cfset} = 1;

    foreach $cf (@{$cfset2cfile{$cfset}}) {
      if (process_rules($cf, $trace)) {
        delete $trace->{$cfset};
        return 1;
      }
    }

    delete $trace->{$cfset};
  }

  return 0;
}


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

sub match_pair_operations {

  my($rule) = $_[0];
  my($ret, $key, $oper);
  my(%subst, @context2, @action2);

  $ret = 0;   # shows if matches were found

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

    # since operations might be cancelled by other operations in this loop,
    # check if operation with the given key still exists

    if (!exists($rule->{"Operations"}->{$key}))  { next; }
    $oper = $rule->{"Operations"}->{$key};

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

    if (exists($rule->{"ContPreEval2"}) &&
        !tval_context_expr($oper->{"Context2"}))  { next; }

    # check if last N lines of input buffer match the pattern specified
    # by operation; if the pattern returned any values, assign them to %subst,
    # otherwise leave %subst empty

    if ($matchfunc[$rule->{"PatType2"}]->($rule->{"PatLines2"},
                                          $oper->{"Pattern2"},
                                          \%subst, $rule->{"VarMap2"})) {

      # evaluate the context expression of the rule

      if (scalar(@{$oper->{"Context2"}}) &&
          !exists($rule->{"ContPreEval2"})) {

        if (scalar(%subst) && exists($rule->{"ContVolat2"})) {
          copy_context($oper->{"Context2"}, \@context2);
          subst_context(\%subst, \@context2, '$');
          if (!tval_context_expr(\@context2))  { next; }
        } else {
          if (!tval_context_expr($oper->{"Context2"}))  { next; }
        }
      }

      # if the operation type is Pair, execute the 2nd action if the
      # correlation window has not expired, and terminate the operation

      if ($rule->{"Type"} == PAIR) {

        if (!$oper->{"Window"} ||
            time() - $oper->{"Time"} <= $oper->{"Window"}) {

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

          if (scalar(%subst)) {

            if (exists($rule->{"ActVolat2"})) {
              if (!exists($oper->{"Act2Copied"})) {
                copy_actionlist($rule->{"Action2"}, \@action2);
                $oper->{"Action2"} = \@action2;
              }
              subst_actionlist(\%subst, $oper->{"Action2"}, '$');
            }
            subst_string(\%subst, $oper->{"Desc2"}, '$');
          }

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

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

      # if the operation type is PairWithWindow, execute the 2nd action and
      # terminate the operation (note that the event correlation window is
      # not checked for the execution of the 1st action, in order to achieve
      # good event ordering - if the 1st action creates a synthetic event,
      # it would always appear after the current event)

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

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

        if (scalar(%subst)) {

          if (exists($rule->{"ActVolat2"})) {
            if (!exists($oper->{"Act2Copied"})) {
              copy_actionlist($rule->{"Action2"}, \@action2);
              $oper->{"Action2"} = \@action2;
            }
            subst_actionlist(\%subst, $oper->{"Action2"}, '$');
          }
          subst_string(\%subst, $oper->{"Desc2"}, '$');
        }

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

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

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

  return $ret;

}


# Parameters: par1 - name of the configuration file
#             par2 - rule index inside the configuration file
#             par3 - trace hash for detecting loops during recursive calls
#                    (this parameter is needed for processing Jump rules)
# Action: match the par2-th rule from the file par1 against input, and
#         process the rule if match was found.
#         The function returns the rule index in the configuration file
#         where the processing should continue.

sub match_1pattern_rule {

  my($conffile, $index, $trace) = @_;
  my($rule, %subst, @context);

  $rule = $configuration{$conffile}->[$index];

  # check if the rule context expression must be evaluated before
  # comparing input line(s) with the pattern; if the expression
  # evaluates FALSE, continue processing from the next rule

  if (exists($rule->{"ContPreEval"}) &&
      !tval_context_expr($rule->{"Context"}))  { return $index+1; }

  # check if last N lines of input buffer match the pattern specified
  # by rule; if the pattern returned any values, assign them to %subst,
  # otherwise leave %subst empty

  if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"},
                                       $rule->{"Pattern"},
                                       \%subst, $rule->{"VarMap"})) {

    # evaluate the context expression of the rule; if the expression
    # evaluates FALSE, continue processing from the next rule

    if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) {

      if (scalar(%subst) && exists($rule->{"ContVolat"})) {
        copy_context($rule->{"Context"}, \@context);
        subst_context(\%subst, \@context, '$');
        if (!tval_context_expr(\@context))  { return $index+1; }
      } else {
        if (!tval_context_expr($rule->{"Context"}))  { return $index+1; }
      }
    }

    # increment the counter that reflects the rule usage
    ++$rule->{"MatchCount"};

    # process the rule (note that the GoTo field is set to $index+1
    # if continue=TakeNext; -1 if continue=EndMatch; "total number
    # of rules in the current configuration file" if continue=DontCont

    # if rule is of type SUPPRESS, return immediately (note that
    # the GotoRule field is set to total number of rules in the current
    # configuration file which denotes end of processing for the file)

    if ($rule->{"Type"} == SUPPRESS)  { return $rule->{"GotoRule"}; }

    # if rule is of type JUMP, process the rule with the extra $trace
    # parameter for detecting processing loops, and return the number of
    # the rule specified with continue; if during recursive processing
    # continue*=EndMatch statement was encountered, return -1 as if
    # continue=EndMatch for this Jump rule

    if ($rule->{"Type"} == JUMP) {
      if ($processrulefunc[JUMP]->($rule, \%subst, $conffile, $trace)) {
        return -1;
      } else {
        return $rule->{"GotoRule"};
      }
    }

    # generic processing for other rule types

    $processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile);
    return $rule->{"GotoRule"};

  }

  # if the pattern did not match, continue processing from the next rule
  return $index+1;

}


# Parameters: par1 - name of the configuration file
#             par2 - rule index inside the configuration file
# Action: match the par2-th rule from the file par1 against input, and
#         process the rule if match was found.
#         The function returns the rule index in the configuration file
#         where the processing should continue.

sub match_2pattern_rule {

  my($conffile, $index) = @_;
  my($rule, %subst, @context);

  $rule = $configuration{$conffile}->[$index];

  CHECK_1ST_PAT: {

    # check if the rule context expression must be evaluated before comparing
    # input line(s) with the pattern; if the expression evaluates FALSE,
    # process event correlation operations associated with the rule and check
    # if their 2nd patterns match

    if (exists($rule->{"ContPreEval"}) &&
        !tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; }

    # check if last N lines of input buffer match the pattern specified
    # by rule; if the pattern returned any values, assign them to %subst,
    # otherwise leave %subst empty

    if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"},
                                         $rule->{"Pattern"},
                                         \%subst, $rule->{"VarMap"})) {

      # evaluate the context expression of the rule; if the expression
      # evaluates FALSE, process event correlation operations associated
      # with the rule and check if their 2nd patterns match

      if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) {

        if (scalar(%subst) && exists($rule->{"ContVolat"})) {
          copy_context($rule->{"Context"}, \@context);
          subst_context(\%subst, \@context, '$');
          if (!tval_context_expr(\@context)) { last CHECK_1ST_PAT; }
        } else {
          if (!tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; }
        }
      }

      # increment the counter that reflects the rule usage
      ++$rule->{"MatchCount"};

      # process the rule
      $processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile);

      # return the number of the rule specified with continue (note that
      # for TakeNext the GotoRule field is set to $index+1, for DontCont
      # it is set to total number of rules in the file, while for EndMatch
      # it is set to -1)

      return $rule->{"GotoRule"};

    }
  }   # end of CHECK_1ST_PAT

  # if the pattern did not match, process event correlation operations
  # associated with the rule and check if their 2nd patterns match

  if (scalar(%{$rule->{"Operations"}}) && match_pair_operations($rule)) {
    return $rule->{"GotoRule2"};
  }

  # if there were no operations or no matching 2nd patterns, continue
  # processing from the next rule
  return $index+1;

}


# Parameters: par1 - name of the configuration file
#             par2 - rule index inside the configuration file
# Action: match the par2-th rule from the file par1 against input, and
#         process the rule if match was found.
#         The function returns the rule index in the configuration file
#         where the processing should continue.

sub match_eventgroup_rule {

  my($conffile, $index) = @_;
  my($rule, $i, %subst, @context);

  $rule = $configuration{$conffile}->[$index];

  for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {

    # check if the rule context expression must be evaluated before
    # comparing input line(s) with the pattern; if the expression
    # evaluates FALSE, move to the next pattern

    if (exists($rule->{"ContPreEvalList"}->{$i}) &&
        !tval_context_expr($rule->{"ContextList"}->[$i]))  { next; }

    # check if last N lines of input buffer match the pattern specified
    # by rule; if the pattern returned any values, assign them to %subst,
    # otherwise leave %subst empty

    if ($matchfunc[$rule->{"PatTypeList"}->[$i]]->(
                                          $rule->{"PatLinesList"}->[$i],
                                          $rule->{"PatternList"}->[$i],
                                          \%subst,
                                          $rule->{"VarMapList"}->[$i])
                                          ) {

      # evaluate the context expression of the rule; if the expression
      # evaluates FALSE, move to the next pattern

      if (scalar(@{$rule->{"ContextList"}->[$i]}) &&
          !exists($rule->{"ContPreEvalList"}->{$i})) {

        if (scalar(%subst) && exists($rule->{"ContVolatList"}->{$i})) {
          copy_context($rule->{"ContextList"}->[$i], \@context);
          subst_context(\%subst, \@context, '$');
          if (!tval_context_expr(\@context))  { next; }
        } else {
          if (!tval_context_expr($rule->{"ContextList"}->[$i]))  { next; }
        }
      }

      # increment the counter that reflects the rule usage
      ++$rule->{"MatchCount"};

      # process the rule
      $processrulefunc[EVENT_GROUP]->($rule, \%subst, $conffile, $i);

      # return the number of the rule specified with continue for current
      # pattern (note that for TakeNext the GotoRule field is set to $index+1,
      # for DontCont it is set to total number of rules in the file, while
      # for EndMatch it is set to -1)

      return $rule->{"GotoRuleList"}->[$i];

    }
  }

  # if there was no matching pattern, continue processing from the next rule
  return $index+1;

}


# Parameters: par1 - name of the configuration file
#             par2 - trace hash for detecting loops during recursive calls
# Action: match the rules from configuration file par1 against the current
#         content of input buffer. If during the matching continue*=EndMatch
#         statement is encountered, return 1, otherwise return 0.

sub process_rules {

  my($conffile, $trace) = @_;
  my($i, $n, $rule, $cpu_total, $cpu_user, $cpu_sys);

  $i = 0;
  $n = scalar(@{$configuration{$conffile}});

  # with --ruleperf option, collect CPU time data when rules are processed

  if ($ruleperf) {

    while ($i < $n) {

      $rule = $configuration{$conffile}->[$i];

      # skip the CALENDAR rule
      if ($rule->{"Type"} == CALENDAR)  { ++$i; next; }

      # find CPU time of the process before the rule is processed

      ($cpu_user, $cpu_sys) = times();
      $cpu_total = $cpu_user + $cpu_sys;

      # match the i-th rule against input
      $i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace);

      # find CPU time of the process after the rule has been processed
      # and calculate CPU time spent for processing the rule

      ($cpu_user, $cpu_sys) = times();
      $rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total;

      # increment the counter of total events processed by the rule
      ++$rule->{"EventCount"};

      # if the rule matching function returned -1 for the offset of
      # the next rule to be matched, terminate all matching and return 1

      if ($i == -1)  { return 1; }
    }

  } else {

    while ($i < $n) {

      $rule = $configuration{$conffile}->[$i];

      # skip the CALENDAR rule
      if ($rule->{"Type"} == CALENDAR)  { ++$i; next; }

      # match the i-th rule against input
      $i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace);

      # if the rule matching function returned -1 for the offset of
      # the next rule to be matched, terminate all matching and return 1

      if ($i == -1)  { return 1; }
    }

  }

  return 0;
}


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

sub process_lists {

  my($key, $rule, $oper);
  my($time, @time, $pevt, $event, $context, @buffer, $file, $peer);
  my($minute, $hour, $day, $month, $year, $weekday);
  my($lastdayofmonth, $shortyear, $cpu_total, $cpu_user, $cpu_sys);

  # remove obsolete elements from %context_list

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

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

  if (scalar(@pending_events)) {

    @buffer = ();
    $time = time();

    foreach $pevt (@pending_events) {
      if ($time >= $pevt->[0]) {
        $event = $pevt->[1];
        $context = $pevt->[2];
        log_msg(LOG_DEBUG, "Creating event '$event'");
        push @events, $event, $context;
      } else { push @buffer, $pevt; }
    }

    @pending_events = @buffer;
  }

  # check the status of new connections over TCP and unix stream sockets
  # which are not yet established

  if (scalar(%output_tcpconn)) {
    foreach $peer (keys %output_tcpconn) {
      check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer");
    }
  }

  if (scalar(%output_ustrconn)) {
    foreach $file (keys %output_ustrconn) {
      check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket");
    }
  }

  # detect established connections over TCP and unix stream sockets that
  # have been closed by peers or have errors, and close relevant sockets

  if (scalar(%output_tcpsock)) {
    check_established_conns(\%output_tcpsock, "TCP peer");
  }

  if (scalar(%output_ustream)) {
    check_established_conns(\%output_ustream, "socket");
  }

  # process CALENDAR rules

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

  $lastdayofmonth = ((localtime(time()+86400))[3] == 1);
  $shortyear = $year % 100;

  foreach $rule (@calendar) {

    # if we have already executed an action in the current minute, skip

    if ($minute == $rule->{"LastActionMinute"} &&
        $hour == $rule->{"LastActionHour"} &&
        $day == $rule->{"LastActionDay"} &&
        $month == $rule->{"LastActionMonth"} &&
        $year == $rule->{"LastActionYear"})  { next; }

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

    if (!exists($rule->{"Minutes"}->{$minute}))  { next; }
    if (!exists($rule->{"Hours"}->{$hour}))  { next; }

    if (!exists($rule->{"Days"}->{$day}) &&
        !($lastdayofmonth && exists($rule->{"Days"}->{"0"})))  { next; }

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

    # with --ruleperf option, find process CPU time before rule is processed

    if ($ruleperf) {
      ($cpu_user, $cpu_sys) = times();
      $cpu_total = $cpu_user + $cpu_sys;
    }

    # if the rule has no context expression, or the context expression
    # exists and evaluates true, execute the action list of the calendar
    # event and save current time

    if (!scalar(@{$rule->{"Context"}}) ||
        tval_context_expr($rule->{"Context"})) {

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

      $rule->{"LastActionMinute"} = $minute;
      $rule->{"LastActionHour"} = $hour;
      $rule->{"LastActionDay"} = $day;
      $rule->{"LastActionMonth"} = $month;
      $rule->{"LastActionYear"} = $year;

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

    # with --ruleperf option, find process CPU time after rule has been
    # processed and calculate CPU time spent for processing the rule,
    # and increment the counter of total events processed by the rule

    if ($ruleperf) {

      ($cpu_user, $cpu_sys) = times();
      $rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total;

      ++$rule->{"EventCount"};
    }
  }

  # accomplish clock-based tasks that are associated with elements of
  # %corr_list (event correlation operations) and remove obsolete elements

  foreach $key (keys %corr_list) {

    # since operations might be cancelled by other operations in this loop,
    # check if operation with the given key still exists

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

    $oper = $corr_list{$key};
    $time = time();

    # if the correlation window has not expired, move to next operation
    if ($time - $oper->{"Time"} <= $oper->{"Window"})  { next; }

    $rule = $configuration{$oper->{"File"}}->[$oper->{"ID"}];

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

    if ($oper->{"Type"} == SINGLE_W_SUPPRESS) {
      delete $corr_list{$key};   # terminate the operation
    }

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

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

      # if the window is not set to infinity, terminate the operation

      if ($oper->{"Window"}) {
        delete $corr_list{$key};
        delete $rule->{"Operations"}->{$key};
      }
    }

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

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

      # execute the 1st action and terminate the operation

      execute_actionlist($oper->{"Action"}, $oper->{"Desc"});
      delete $corr_list{$key};
      delete $rule->{"Operations"}->{$key};
    }

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

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

      if (!exists($oper->{"SuppressMode"})) {

        # if the operation is not in suppress mode, slide the window forward;
        # if no events remain in the window, terminate the operation

        update_times_swt($oper, $time - $oper->{"Window"});
        if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }

      } else {

        # if the operation is in suppress mode, terminate it

        execute_actionlist($oper->{"Action2"}, $oper->{"Desc"});
        delete $corr_list{$key};
      }
    }

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

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

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

        # if the operation is in rising threshold mode, slide the window
        # forward; if no events remain in the window, terminate the operation

        update_times_swt($oper, $time - $oper->{"Window"});
        if (!scalar(@{$oper->{"Times"}}))  { delete $corr_list{$key}; }

      } else {

        # if the operation is in falling threshold mode, terminate it

        execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"});
        delete $corr_list{$key};
      }
    }

    # ------------------------------------------------------------
    # EVENT_GROUP rule
    # ------------------------------------------------------------

    elsif ($oper->{"Type"} == EVENT_GROUP) {

      if (!exists($oper->{"SuppressMode"})) {

        # if the operation is not in suppress mode, slide the window forward;
        # if no events remain in the window, terminate the operation

        update_times_eg($oper, $time - $oper->{"Window"});

        if (!scalar(@{$oper->{"AllTimes"}})) {
          $oper->{"DeleteInProgress"} = 1;
          execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
          delete $corr_list{$key};
        } else {
          execute_actionlist($oper->{"SlideAction"}, $oper->{"Desc"});
        }

      } else {

        # if the operation window has expired and the operation is in
        # event suppressing mode, terminate it

        $oper->{"DeleteInProgress"} = 1;
        execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"});
        delete $corr_list{$key};
      }
    }

  }
}


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


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

sub actionlist2str {

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

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

  while ($i < $j) {

    if ($actionlist->[$i] == NONE) {
      $result .= "none";
      ++$i;
    }

    elsif ($actionlist->[$i] == LOGONLY) {
      $result .= "logonly " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == WRITE) {
      $result .= "write " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == WRITEN) {
      $result .= "writen " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CLOSEF) {
      $result .= "closef " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == OWRITECL) {
      $result .= "owritecl " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == UDGRAM) {
      $result .= "udgram " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CLOSEUDGR) {
      $result .= "closeudgr " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == USTREAM) {
      $result .= "ustream " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CLOSEUSTR) {
      $result .= "closeustr " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == UDPSOCK) {
      $result .= "udpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CLOSEUDP) {
      $result .= "closeudp " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == TCPSOCK) {
      $result .= "tcpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CLOSETCP) {
      $result .= "closetcp " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == SHELLCOMMAND) {
      $result .= "shellcmd " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == COMMANDEXEC) {
      $result .= "cmdexec " . join(" ", @{$actionlist->[$i+1]});
      $i += 2;
    }

    elsif ($actionlist->[$i] == SPAWN) {
      $result .= "spawn " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == SPAWNEXEC) {
      $result .= "spawnexec " . join(" ", @{$actionlist->[$i+1]});
      $i += 2;
    }

    elsif ($actionlist->[$i] == CSPAWN) {
      $result .= "cspawn " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CSPAWNEXEC) {
      $result .= "cspawnexec " . $actionlist->[$i+1]
                 . " " .  join(" ", @{$actionlist->[$i+2]});
      $i += 3;
    }

    elsif ($actionlist->[$i] == PIPE) {
      $result .= "pipe " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == PIPEEXEC) {
      $result .= "pipeexec " . $actionlist->[$i+1]
                 . " " . join(" ", @{$actionlist->[$i+2]});
      $i += 3;
    }

    elsif ($actionlist->[$i] == CREATECONTEXT) {
      $result .= "create " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      if (scalar(@{$actionlist->[$i+3]})) {
        $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";
      }
      $i += 4;
    }

    elsif ($actionlist->[$i] == DELETECONTEXT) {
      $result .= "delete " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == OBSOLETECONTEXT) {
      $result .= "obsolete " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == SETCONTEXT) {
      $result .= "set " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      if (scalar(@{$actionlist->[$i+3]})) {
        $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")";
      }
      $i += 4;
    }

    elsif ($actionlist->[$i] == ALIAS) {
      $result .= "alias " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == UNALIAS) {
      $result .= "unalias " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == ADD) {
      $result .= "add " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == PREPEND) {
      $result .= "prepend " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == FILL) {
      $result .= "fill " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == REPORT) {
      $result .= "report " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == REPORTEXEC) {
      $result .= "reportexec " . $actionlist->[$i+1]
                 . " " . join(" ", @{$actionlist->[$i+2]});
      $i += 3;
    }

    elsif ($actionlist->[$i] == COPYCONTEXT) {
      $result .= "copy " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == EMPTYCONTEXT) {
      if (length($actionlist->[$i+2])) {
        $result .= "empty " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
      } else {
        $result .= "empty " . $actionlist->[$i+1];
      }
      $i += 3;
    }

    elsif ($actionlist->[$i] == POP) {
      $result .= "pop " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == SHIFT) {
      $result .= "shift " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == EXISTS) {
      $result .= "exists %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == GETSIZE) {
      $result .= "getsize %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == GETALIASES) {
      $result .= "getaliases %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == GETLIFETIME) {
      $result .= "getltime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == SETLIFETIME) {
      $result .= "setltime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == GETCTIME) {
      $result .= "getctime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == SETCTIME) {
      $result .= "setctime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == EVENT) {
      $result .= "event " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == TEVENT) {
      $result .= "tevent " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == CEVENT) {
      $result .= "cevent " . $actionlist->[$i+1] . " "
                 . $actionlist->[$i+2] . " " . $actionlist->[$i+3];
      $i += 4;
    }

    elsif ($actionlist->[$i] == RESET) {
      $result .= "reset " . $actionlist->[$i+2] . " " . $actionlist->[$i+3];
      $i += 4;
    }

    elsif ($actionlist->[$i] == GETWINPOS) {
      $result .= "getwpos %" . $actionlist->[$i+1] . " "
                 . $actionlist->[$i+3] . " " . $actionlist->[$i+4];
      $i += 5;
    }

    elsif ($actionlist->[$i] == SETWINPOS) {
      $result .= "setwpos " . $actionlist->[$i+1] . " "
                 . $actionlist->[$i+3] . " " . $actionlist->[$i+4];
      $i += 5;
    }

    elsif ($actionlist->[$i] == ASSIGN) {
      $result .= "assign %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == ASSIGNSQ) {
      $result .= "assignsq %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == FREE) {
      $result .= "free %" . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == EVAL) {
      $result .= "eval %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

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

    elsif ($actionlist->[$i] == LCALL) {
      $result .= "lcall %" . $actionlist->[$i+1]
                 . " " . join(" ", @{$actionlist->[$i+3]}) . " ";
      if ($actionlist->[$i+4])  { $result .= ":>" }  else { $result .= "->" }
      $result .= " " . $actionlist->[$i+2];
      $i += 5;
    }

    elsif ($actionlist->[$i] == REWRITE) {
      $result .= "rewrite " . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == ADDINPUT) {
      $result .= "addinput " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]
                 . " " . $actionlist->[$i+3];
      $i += 4;
    }

    elsif ($actionlist->[$i] == DROPINPUT) {
      $result .= "dropinput " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == SIGEMUL) {
      $result .= "sigemul " . $actionlist->[$i+1];
      $i += 2;
    }

    elsif ($actionlist->[$i] == VARIABLESET) {
      $result .= "varset %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2];
      $i += 3;
    }

    elsif ($actionlist->[$i] == IF) {
      $result .= "if %" . $actionlist->[$i+1] . " (";
      if (scalar(@{$actionlist->[$i+2]})) {
        $result .= actionlist2str($actionlist->[$i+2]);
      }
      if (scalar(@{$actionlist->[$i+3]})) {
        $result .= ") else (";
        $result .= actionlist2str($actionlist->[$i+3]);
      }
      $result .= ")";
      $i += 4;
    }

    elsif ($actionlist->[$i] == WHILE) {
      $result .= "while %" . $actionlist->[$i+1] . " (";
      if (scalar(@{$actionlist->[$i+2]})) {
        $result .= actionlist2str($actionlist->[$i+2]);
      }
      $result .= ")";
      $i += 3;
    }

    elsif ($actionlist->[$i] == BREAK) {
      $result .= "break";
      ++$i;
    }

    elsif ($actionlist->[$i] == CONTINUE) {
      $result .= "continue";
      ++$i;
    }

    else { return "Unknown action type in the action list"; }

    $result .= "; ";

  }

  return $result;

}


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

sub pattern2str {

  my($type, $lines, $pattern) = @_;

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

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

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

  elsif ($type == CACHED) {
    return "cached match: $pattern";
  }

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

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

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

  elsif ($type == NCACHED) {
    return "negative cached match: $pattern";
  }

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

  else { return "Unknown pattern type"; }

}


# Parameters: par1 - continue value
#             par2 - rule number
# Action: convert continue parameters to a printable representation

sub continue2str {

  my($whatnext, $gotorule) = @_;

  if ($whatnext == DONTCONT) { return "don't continue"; }
  elsif ($whatnext == TAKENEXT) { return "take next"; }
  elsif ($whatnext == GOTO) { return "goto rule " . ($gotorule + 1); }
  elsif ($whatnext == ENDMATCH) { return "end matching"; }
  else { return "Unknown continue value"; }

}


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

sub context2str {

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

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

  while ($i < $j) {

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

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

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

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

    elsif ($ref->[$i] == VARSET) {
      $op1 = $ref->[$i+1];
      push @stack, "varset $op1";
      $i += 2;
    }

    elsif ($ref->[$i] == OPERAND) {
      $op1 = $ref->[$i+1];
      push @stack, $op1;
      $i += 2;
    }

    elsif ($ref->[$i] == NEGATION) {
      $op1 = pop @stack;
      push @stack, "!" . $op1;
      ++$i;
    }

    elsif ($ref->[$i] == AND) {
      $op2 = pop @stack;
      $op1 = pop @stack;
      push @stack, $op1 . " && " . $op2;
      ++$i;
    }

    elsif ($ref->[$i] == OR) {
      $op2 = pop @stack;
      $op1 = pop @stack;
      push @stack, $op1 . " || " . $op2;
      ++$i;
    }

    else { return "Unknown operator in the context expression"; }

  }

  $result = pop @stack;

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

  return $result;

}


# Parameters: par1 - filehandle
#             par2 - key of event correlation operation
#             par3 - reference to event correlation operation
# Action: print given event correlation operation to the filehandle

sub print_operation {

  my($handle, $key, $oper) = @_;
  my($rule, $conffile, $id, $time, $elem, $i, $j);

  print $handle "Key: ", $key, "\n";
  print $handle "Operation started at: ",
                scalar(localtime($oper->{"StartTime"})), "\n";
  print $handle "Correlation window begins at: ",
                scalar(localtime($oper->{"Time"})), "\n";

  if ($oper->{"Window"}) {
    print $handle "Correlation window ends at: ",
                  scalar(localtime($oper->{"Time"} + $oper->{"Window"})), "\n";
  }

  $conffile = $oper->{"File"};
  $id = $oper->{"ID"};
  $rule = $configuration{$conffile}->[$id];

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

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

    print $handle "Type: SingleWithSuppress\n";

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

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

    print $handle "Behavior after match: ";
    print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

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

    print $handle "\n";

  }

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

    print $handle "Type: Pair\n";

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

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

    print $handle "Behavior after match: ";
    print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

    print $handle "Pattern2: ";
    print $handle pattern2str($rule->{"PatType2"},
                  $rule->{"PatLines2"}, $oper->{"Pattern2"});
    print $handle "\n";

    print $handle "Context2: ";
    print $handle context2str($oper->{"Context2"});
    print $handle "\n";

    print $handle "Behavior after match2: ";
    print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"});
    print $handle "\n";

    print $handle "Description2: ", $oper->{"Desc2"}, "\n";

    print $handle "Action2: ";
    print $handle actionlist2str($oper->{"Action2"});
    print $handle "\n";

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

    print $handle "\n";

  }

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

    print $handle "Type: PairWithWindow\n";

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

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

    print $handle "Behavior after match: ";
    print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

    print $handle "Pattern2: ";
    print $handle pattern2str($rule->{"PatType2"},
                  $rule->{"PatLines2"}, $oper->{"Pattern2"});
    print $handle "\n";

    print $handle "Context2: ";
    print $handle context2str($oper->{"Context2"});
    print $handle "\n";

    print $handle "Behavior after match2: ";
    print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"});
    print $handle "\n";

    print $handle "Description2: ", $oper->{"Desc2"}, "\n";

    print $handle "Action2: ";
    print $handle actionlist2str($oper->{"Action2"});
    print $handle "\n";

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

    print $handle "\n";

  }

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

    print $handle "Type: SingleWithThreshold\n";

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

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

    print $handle "Behavior after match: ";
    print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

    print $handle "Action2: ";
    print $handle actionlist2str($oper->{"Action2"});
    print $handle "\n";

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

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

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

    if (exists($oper->{"SuppressMode"})) {
      print $handle "(seen before threshold was crossed):\n";
    } else {
      print $handle "(checking for threshold):\n";
    }

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

    print $handle "\n";

  }

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

    print $handle "Type: SingleWith2Thresholds\n";

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

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

    print $handle "Behavior after match: ";
    print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

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

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

    print $handle "Description2: ", $oper->{"Desc2"}, "\n";

    print $handle "Action2: ";
    print $handle actionlist2str($oper->{"Action2"});
    print $handle "\n";

    print $handle "Window2: ", $rule->{"Window2"}, " seconds\n";

    print $handle "Threshold2: ", $rule->{"Threshold2"}, "\n";

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

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

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

    print $handle "\n";

  }

  elsif ($oper->{"Type"} == EVENT_GROUP) {

    print $handle "Type: EventGroup", $rule->{"EventNumber"}, "\n";

    for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {

      $j = ($i==0)?"":($i+1);

      print $handle "Pattern$j: ";
      print $handle pattern2str($rule->{"PatTypeList"}->[$i],
                                $rule->{"PatLinesList"}->[$i],
                                $rule->{"PatternList"}->[$i]);
      print $handle "\n";

      print $handle "Context$j: ";
      print $handle context2str($rule->{"ContextList"}->[$i]);
      print $handle "\n";

      print $handle "Behavior after match$j: ";
      print $handle continue2str($rule->{"WhatNextList"}->[$i],
                                 $rule->{"GotoRuleList"}->[$i]);
      print $handle "\n";

      print $handle "Count action$j: ";
      print $handle actionlist2str($rule->{"CountActionList"}->[$i]);
      print $handle "\n";

      print $handle "Threshold$j: ";
      print $handle $rule->{"ThresholdList"}->[$i];
      print $handle "\n";
    }

    if (exists($rule->{"EGrpPattern"})) {
      print $handle "Event group pattern: ";
      print $handle pattern2str($rule->{"EGrpPatType"}, 1,
                                $rule->{"EGrpPattern"});
      print $handle "\n";
    }

    print $handle "Init action: ";
    print $handle actionlist2str($oper->{"InitAction"});
    print $handle "\n";

    print $handle "Slide action: ";
    print $handle actionlist2str($oper->{"SlideAction"});
    print $handle "\n";

    print $handle "End action: ";
    print $handle actionlist2str($oper->{"EndAction"});
    print $handle "\n";

    print $handle "Description: ", $oper->{"Desc"}, "\n";

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

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

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

    if (exists($oper->{"SuppressMode"})) {
      print $handle "(seen before thresholds were crossed):\n";
    } else {
      print $handle "(checking for thresholds):\n";
    }

    foreach $elem (@{$oper->{"AllTimes"}}) {
      print $handle scalar(localtime($elem->[0]));
      print $handle " (matched by pattern #", $elem->[1]+1, ")";
      print $handle "\n";
    }

    print $handle "\n";

  }

  else { print $handle "Unknown operation type in the list\n\n"; }

}


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

sub dump_data {

  my($dfilename, $dhandle, $i, $key, $ref, $file, $event, $fpos, @stat);
  my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids);
  my($len, $width1, $width2, $width3, $width4, $width5);
  my($name, %reported_names);

  # get the current time

  $time = time();

  # with --dumpfts command line option, include seconds since epoch
  # in the dump file name as a suffix

  if ($dumpfts) {
    $dfilename = "$dumpfile.$time";
  } else {
    $dfilename = $dumpfile;
  }

  # verify that dumpfile does not exist and open it

  if (-e $dfilename) {
    log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists");
    return;
  }

  if (!open($dhandle, ">$dfilename")) {
    log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)");
    return;
  }


  # print program info

  print $dhandle "Program information:\n";
  print $dhandle '=' x 60, "\n";

  print $dhandle "Program version: ", $SEC_VERSION, "\n";
  print $dhandle "Time of the start: ",
                 scalar(localtime($startuptime)), "\n";
  print $dhandle "Time of the last configuration load: ",
                 scalar(localtime($lastconfigload)), "\n";
  print $dhandle "Time of the dump: ", scalar(localtime($time)), "\n";
  print $dhandle "Program resource file: ", $rcfile_status, "\n";
  print $dhandle "Program options: ", $sec_options, "\n";

  # note that $) can report the same supplementary group ID more than once

  @gidlist = split(' ', $) );
  $egid = shift @gidlist;
  %gids = map { $_ => 1 } @gidlist;

  print $dhandle "Effective user ID: ", $>, "\n";
  print $dhandle "Effective group ID: ", $egid, "\n";
  print $dhandle "Supplementary group IDs: ", join(" ", keys %gids), "\n";

  print $dhandle "\n";

  # print environment info

  print $dhandle "Environment:\n";
  print $dhandle '=' x 60, "\n";

  foreach $key (sort(keys %ENV)) {
    print $dhandle "$key=", $ENV{$key}, "\n";
  }

  print $dhandle "\n";

  # print performance statistics

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

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

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

  print $dhandle "\n";

  # print rule usage statistics

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

  foreach $file (@conffiles) {

    print $dhandle "\nStatistics for the rules from $file\n";
    print $dhandle "(loaded at ",
                    scalar(localtime($config_ltimes{$file})), ")\n";
    print $dhandle '-' x 60, "\n";

    $width1 = length(sprintf("%u", scalar(@{$configuration{$file}})));
    $width2 = $width3 = 0;
    if ($ruleperf) { $width4 = $width5 = 0; }

    foreach $ref (@{$configuration{$file}}) {
      $len = length(sprintf("%u", $ref->{"LineNo"}));
      if ($len > $width2) { $width2 = $len; }
      $len = length(sprintf("%u", $ref->{"MatchCount"}));
      if ($len > $width3) { $width3 = $len; }
      if ($ruleperf) {
        $len = length(sprintf("%.2f", $ref->{"CPUtime"}));
        if ($len > $width4) { $width4 = $len; }
        $len = length(sprintf("%u", $ref->{"EventCount"}));
        if ($len > $width5) { $width5 = $len; }
      }
    }

    $i = 1;

    foreach $ref (@{$configuration{$file}}) {
      printf $dhandle "Rule %*u line %*u matched %*u events",
        $width1, $i, $width2, $ref->{"LineNo"}, $width3, $ref->{"MatchCount"};
      if ($ruleperf) {
        printf $dhandle
          ", %*.*f seconds of CPU time spent for processing %*u events",
          $width4, 2, $ref->{"CPUtime"}, $width5, $ref->{"EventCount"};
      }
      print $dhandle " (", $ref->{"Desc"}, ")\n";
      ++$i;
    }

  }

  print $dhandle "\n";

  # print input sources

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

  foreach $file (@inputfiles) {

    print $dhandle $file, " ";

    if ($inputsrc{$file}->{"open"}) {
      print $dhandle "(status: Open, ";
      if ($inputsrc{$file}->{"regfile"}) {
        $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
        @stat = stat($inputsrc{$file}->{"fh"});
        print $dhandle "type: regular file, ";
        # sysseek returns a string "0 but true" for offset 0,
        # so force numeric context by adding 0
        print $dhandle "read offset: ", defined($fpos)?$fpos+0:"undef", ", ";
        print $dhandle "file size: ", scalar(@stat)?$stat[7]:"undef";
      } else {
        print $dhandle "type: pipe";
      }
      print $dhandle ", ";
      print $dhandle "device/inode: ", $inputsrc{$file}->{"dev"};
      print $dhandle "/", $inputsrc{$file}->{"inode"}, ", ";
    } else {
      print $dhandle "(status: Closed, ";
    }

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

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

    print $dhandle ")\n";

  }

  print $dhandle "\n";

  # print the content of input buffer(s)

  if ($jointbuf) {

    print $dhandle "Input buffering mode: ";
    print $dhandle "joint buffer for all input sources\n";
    print $dhandle "Size of input buffer: $bufsize\n";
    print $dhandle "\n";

    print $dhandle "Content of input buffer (last $bufsize input line(s)):\n";
    print $dhandle '-' x 60, "\n";

    for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
      print $dhandle $input_buffer[$i], "\n";
    }

    print $dhandle '-' x 60, "\n";
    print $dhandle "\n";

    print $dhandle "Last $bufsize input source(s):\n";
    print $dhandle '-' x 60, "\n";

    for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) {
      if (defined($input_sources[$i])) {
        print $dhandle $input_sources[$i], "\n";
      } else {
        print $dhandle "synthetic event\n";
      }
    }

    print $dhandle '-' x 60, "\n";
    print $dhandle "\n";

  } else {

    print $dhandle "Input buffering mode: ";
    print $dhandle "separate buffer for each input source\n";
    print $dhandle "Size of each input buffer: $bufsize\n";
    print $dhandle "\n";

    foreach $file (sort keys %input_buffers) {

      print $dhandle "Content of input buffer for $file:\n";
      print $dhandle '-' x 60, "\n";

      for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1;
           $i <= $input_buffers{$file}->{"BufPos"}; ++$i) {
        print $dhandle $input_buffers{$file}->{"Events"}->[$i], "\n";
      }

      print $dhandle '-' x 60, "\n";
      print $dhandle "\n";

    }

    print $dhandle "Content of input buffer for synthetic events:\n";
    print $dhandle '-' x 60, "\n";

    for ($i = $event_buffer{"BufPos"} - $bufsize + 1;
         $i <= $event_buffer{"BufPos"}; ++$i) {
      print $dhandle $event_buffer{"Events"}->[$i], "\n";
    }

    print $dhandle '-' x 60, "\n";
    print $dhandle "\n";

  }

  # print the content of pending event buffer

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

  foreach $ref (@pending_events) {
    print $dhandle "Event: ", $ref->[1], "\n";
    print $dhandle "Will be created at ", scalar(localtime($ref->[0]));
    if ($intcontexts)  { print $dhandle " with context '", $ref->[2], "'"; }
    print $dhandle "\n\n";
    ++$i;
  }

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

  # print the content of pattern match cache

  $i = 0;
  print $dhandle "Pattern match cache:\n";
  print $dhandle '=' x 60, "\n";

  while (($key, $ref) = each(%pmatch_cache)) {
    print $dhandle "Match: ", $key, "\n";
    foreach $name (sort keys %{$ref}) {
      print $dhandle "$name = ",
                     defined($ref->{$name})?$ref->{$name}:"undef", "\n";
    }
    print $dhandle "\n";
    ++$i;
  }

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

  # print the list of active event correlation operations

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

  while (($key, $ref) = each(%corr_list)) {
    print_operation($dhandle, $key, $ref);
    print $dhandle '-' x 60, "\n";
    ++$i;
  }

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

  # print the list of active contexts

  $i = 0;
  %reported_names = ();
  print $dhandle "List of contexts:\n";
  print $dhandle '=' x 60, "\n";

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

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

    foreach $name (keys %{$ref->{"Aliases"}}) {
      print $dhandle "Context Name: ", $name, "\n";
      $reported_names{$name} = 1;
    }

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

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

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

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

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

  }

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

  # print the list of running children

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

  while (($key, $ref) = each(%children)) {
    print $dhandle "Child PID: ", $key, "\n";
    print $dhandle "Commandline started by child: ", $ref->{"cmd"}, "\n";
    if ($ref->{"open"}) {
      print $dhandle "Connected to pipe input";
      if ($intcontexts && exists($ref->{"context"}))
        { print $dhandle " with context '", $ref->{"context"}, "'"; }
      print $dhandle "\n";
    }
    print $dhandle '-' x 60, "\n";
    ++$i;
  }

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

  # print the values of action list variables

  $i = 0;
  print $dhandle "Action list variables:\n";
  print $dhandle '=' x 60, "\n";

  foreach $key (sort keys %variables) {
    if (defined($variables{$key})) {
      print $dhandle "%$key = '", $variables{$key}, "'\n";
    } else {
      print $dhandle "%$key = undef\n";
    }
    ++$i;
  }

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

  close($dhandle);

  log_msg(LOG_DEBUG, "Dump to $dfilename completed");
}


# Parameters: par1 - reference to hash where operation will be stored
#             par2 - key of event correlation operation
#             par3 - reference to event correlation operation
# Action: store given event correlation operation to the hash par1, so
#         that it can be converted into JSON format (since perl is typeless
#         language, numeric context is set for some fields by adding 0, in
#         order to ensure their conversion into JSON numbers).

sub convert_operation {

  my($ref, $key, $oper) = @_;
  my($rule, $conffile, $id, $elem, $i, $j);

  $ref->{"key"} = $key;
  $ref->{"starttime"} = $oper->{"StartTime"} + 0;
  $ref->{"windowstart"} = $oper->{"Time"} + 0;

  if ($oper->{"Window"}) {
    $ref->{"windowend"} = $oper->{"Time"} + $oper->{"Window"};
  }

  $conffile = $oper->{"File"};
  $id = $oper->{"ID"};
  $rule = $configuration{$conffile}->[$id];

  $ref->{"configfile"} = $conffile;
  $ref->{"ruleid"} = $id + 0;

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

    $ref->{"type"} = "SingleWithSuppress";

    $ref->{"pattern"} = pattern2str($rule->{"PatType"},
                        $rule->{"PatLines"}, $rule->{"Pattern"});

    $ref->{"context"} = context2str($rule->{"Context"});

    $ref->{"continue"} = continue2str($rule->{"WhatNext"},
                         $rule->{"GotoRule"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});

    $ref->{"window"} = $rule->{"Window"} + 0;

  }

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

    $ref->{"type"} = "Pair";

    $ref->{"pattern"} = pattern2str($rule->{"PatType"},
                        $rule->{"PatLines"}, $rule->{"Pattern"});

    $ref->{"context"} = context2str($rule->{"Context"});

    $ref->{"continue"} = continue2str($rule->{"WhatNext"},
                         $rule->{"GotoRule"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});

    $ref->{"pattern2"} = pattern2str($rule->{"PatType2"},
                         $rule->{"PatLines2"}, $oper->{"Pattern2"});

    $ref->{"context2"} = context2str($oper->{"Context2"});

    $ref->{"continue2"} = continue2str($rule->{"WhatNext2"},
                          $rule->{"GotoRule2"});

    $ref->{"desc2"} = $oper->{"Desc2"};
    $ref->{"action2"} = actionlist2str($oper->{"Action2"});

    $ref->{"window"} = $rule->{"Window"} + 0;

  }

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

    $ref->{"type"} = "PairWithWindow";

    $ref->{"pattern"} = pattern2str($rule->{"PatType"},
                        $rule->{"PatLines"}, $rule->{"Pattern"});

    $ref->{"context"} = context2str($rule->{"Context"});

    $ref->{"continue"} = continue2str($rule->{"WhatNext"},
                         $rule->{"GotoRule"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});

    $ref->{"pattern2"} = pattern2str($rule->{"PatType2"},
                         $rule->{"PatLines2"}, $oper->{"Pattern2"});

    $ref->{"context2"} = context2str($oper->{"Context2"});

    $ref->{"continue2"} = continue2str($rule->{"WhatNext2"},
                          $rule->{"GotoRule2"});

    $ref->{"desc2"} = $oper->{"Desc2"};
    $ref->{"action2"} = actionlist2str($oper->{"Action2"});

    $ref->{"window"} = $rule->{"Window"} + 0;

  }

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

    $ref->{"type"} = "SingleWithThreshold";

    $ref->{"pattern"} = pattern2str($rule->{"PatType"},
                        $rule->{"PatLines"}, $rule->{"Pattern"});

    $ref->{"context"} = context2str($rule->{"Context"});

    $ref->{"continue"} = continue2str($rule->{"WhatNext"},
                         $rule->{"GotoRule"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});
    $ref->{"action2"} = actionlist2str($oper->{"Action2"});

    $ref->{"window"} = $rule->{"Window"} + 0;
    $ref->{"threshold"} = $rule->{"Threshold"} + 0;

    if (exists($oper->{"SuppressMode"})) {
      $ref->{"status"} = "threshold reached";
    } else {
      $ref->{"status"} = "checking for threshold";
    }

    $ref->{"eventtimes"} = [];

    foreach $elem (@{$oper->{"Times"}}) {
      push @{$ref->{"eventtimes"}}, $elem + 0;
    }

  }

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

    $ref->{"type"} = "SingleWith2Thresholds";

    $ref->{"pattern"} = pattern2str($rule->{"PatType"},
                        $rule->{"PatLines"}, $rule->{"Pattern"});

    $ref->{"context"} = context2str($rule->{"Context"});

    $ref->{"continue"} = continue2str($rule->{"WhatNext"},
                         $rule->{"GotoRule"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});

    $ref->{"window"} = $rule->{"Window"} + 0;
    $ref->{"threshold"} = $rule->{"Threshold"} + 0;

    $ref->{"desc2"} = $oper->{"Desc2"};
    $ref->{"action2"} = actionlist2str($oper->{"Action2"});

    $ref->{"window2"} = $rule->{"Window2"} + 0;
    $ref->{"threshold2"} = $rule->{"Threshold2"} + 0;

    if (exists($oper->{"2ndPass"})) {
      $ref->{"status"} = "checking for 2nd threshold";
    } else {
      $ref->{"status"} = "checking for 1st threshold";
    }

    $ref->{"eventtimes"} = [];

    foreach $elem (@{$oper->{"Times"}}) {
      push @{$ref->{"eventtimes"}}, $elem + 0;
    }

  }

  elsif ($oper->{"Type"} == EVENT_GROUP) {

    $ref->{"type"} = "EventGroup" . $rule->{"EventNumber"};

    for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) {

      $j = ($i==0)?"":($i+1);

      $ref->{"pattern$j"} = pattern2str($rule->{"PatTypeList"}->[$i],
                                        $rule->{"PatLinesList"}->[$i],
                                        $rule->{"PatternList"}->[$i]);

      $ref->{"context$j"} = context2str($rule->{"ContextList"}->[$i]);

      $ref->{"continue$j"} = continue2str($rule->{"WhatNextList"}->[$i],
                                          $rule->{"GotoRuleList"}->[$i]);

      $ref->{"count$j"} = actionlist2str($rule->{"CountActionList"}->[$i]);

      $ref->{"threshold$j"} = $rule->{"ThresholdList"}->[$i] + 0;
    }

    if (exists($rule->{"EGrpPattern"})) {
      $ref->{"egpattern"} = pattern2str($rule->{"EGrpPatType"}, 1,
                                        $rule->{"EGrpPattern"});
    }

    $ref->{"init"} = actionlist2str($oper->{"InitAction"});
    $ref->{"slide"} = actionlist2str($oper->{"SlideAction"});
    $ref->{"end"} = actionlist2str($oper->{"EndAction"});

    $ref->{"desc"} = $oper->{"Desc"};
    $ref->{"action"} = actionlist2str($oper->{"Action"});

    $ref->{"window"} = $rule->{"Window"} + 0;

    if (exists($oper->{"SuppressMode"})) {
      $ref->{"status"} = "thresholds reached";
    } else {
      $ref->{"status"} = "checking for thresholds";
    }

    $ref->{"eventtimes"} = [];
    $ref->{"eventpatterns"} = [];

    foreach $elem (@{$oper->{"AllTimes"}}) {
      push @{$ref->{"eventtimes"}}, $elem->[0] + 0;
      push @{$ref->{"eventpatterns"}}, $elem->[1] + 1;
    }

  }

  else { $ref->{"status"} = "Unknown operation type in the list"; }

}


# Parameters: -
# Action: save some information about the current state of the program
#         to dump file in JSON format (since perl is typeless language,
#         numeric context is set for some fields by adding 0, in order
#         to ensure their conversion into JSON numbers).

sub dump_data_json {

  my($dfilename, $dhandle, $i, $key, $ref, $file, $fpos, @stat);
  my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids);
  my($name, %reported_names, %data, $json);

  # get the current time

  $time = time();

  # with --dumpfts command line option, include seconds since epoch
  # in the dump file name as a suffix

  if ($dumpfts) {
    $dfilename = "$dumpfile.$time";
  } else {
    $dfilename = $dumpfile;
  }

  # verify that dumpfile does not exist and open it

  if (-e $dfilename) {
    log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists");
    return;
  }

  if (!open($dhandle, ">$dfilename")) {
    log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)");
    return;
  }

  %data = ();

  # program info

  $data{"program"} = {};

  $data{"program"}->{"version"} = $SEC_VERSION;
  $data{"program"}->{"startuptime"} = $startuptime + 0;
  $data{"program"}->{"confloadtime"} = $lastconfigload + 0;
  $data{"program"}->{"dumptime"} = $time + 0;
  $data{"program"}->{"rcfile"} = $rcfile_status;
  $data{"program"}->{"options"} = $sec_options;

  # note that $) can report the same supplementary group ID more than once

  @gidlist = split(' ', $) );
  $egid = shift @gidlist;
  %gids = map { $_ => 1 } @gidlist;

  $data{"program"}->{"euid"} = $> + 0;
  $data{"program"}->{"egid"} = $egid + 0;
  $data{"program"}->{"sgid"} = [ map { $_ + 0 } keys %gids ];

  # environment info

  $data{"env"} = \%ENV;

  # performance statistics

  $data{"perf"} = {};

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

  $data{"perf"}->{"runtime"} = $time - $startuptime;
  $data{"perf"}->{"user"} = $user + 0;
  $data{"perf"}->{"system"} = $system + 0;
  $data{"perf"}->{"childuser"} = $cuser + 0;
  $data{"perf"}->{"childsystem"} = $csystem + 0;
  $data{"perf"}->{"lines"} = $processedlines + 0;

  # rule usage statistics

  $data{"rulestats"} = {};

  foreach $file (@conffiles) {

    $data{"rulestats"}->{$file} = {};
    $data{"rulestats"}->{$file}->{"loadtime"} = $config_ltimes{$file} + 0;
    $data{"rulestats"}->{$file}->{"stats"} = [];

    foreach $ref (@{$configuration{$file}}) {
      push @{$data{"rulestats"}->{$file}->{"stats"}},
                                 { "ruleline" => $ref->{"LineNo"} + 0,
                                   "matches" => $ref->{"MatchCount"} + 0,
                                   "desc" => $ref->{"Desc"} };
      if ($ruleperf) {
        $data{"rulestats"}->{$file}->{"stats"}->[-1]->{"events"} =
                                                $ref->{"EventCount"} + 0;
        $data{"rulestats"}->{$file}->{"stats"}->[-1]->{"cputime"} =
                                                $ref->{"CPUtime"} + 0;
      }
    }

  }

  # input sources

  $data{"inputs"} = {};

  foreach $file (@inputfiles) {

    $data{"inputs"}->{$file} = {};
    $data{"inputs"}->{$file}->{"file"} = $file;

    if ($inputsrc{$file}->{"open"}) {
      $data{"inputs"}->{$file}->{"status"} = "Open";
      if ($inputsrc{$file}->{"regfile"}) {
        $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
        @stat = stat($inputsrc{$file}->{"fh"});
        $data{"inputs"}->{$file}->{"type"} = "regular file";
        # sysseek returns a string "0 but true" for offset 0,
        # so force numeric context by adding 0
        if (defined($fpos)) {
          $data{"inputs"}->{$file}->{"offset"} = $fpos + 0;
        }
        if (scalar(@stat)) {
          $data{"inputs"}->{$file}->{"size"} = $stat[7] + 0;
        }
      } else {
        $data{"inputs"}->{$file}->{"type"} = "pipe";
      }
      # in the case of stdin, dev and inode equal to string value "-"
      $data{"inputs"}->{$file}->{"dev"} = $inputsrc{$file}->{"dev"};
      $data{"inputs"}->{$file}->{"inode"} = $inputsrc{$file}->{"inode"};
    } else {
      $data{"inputs"}->{$file}->{"status"} = "Closed";
    }

    $data{"inputs"}->{$file}->{"lines"} = $inputsrc{$file}->{"lines"} + 0;

    if ($intcontexts) {
      $data{"inputs"}->{$file}->{"context"} = $inputsrc{$file}->{"context"};
    }

  }

  # content of input buffer(s)

  $data{"buffer"} = {};

  if ($jointbuf) {

    $data{"buffer"}->{"bufmode"} = "joint buffer for all input sources";
    $data{"buffer"}->{"bufsize"} = $bufsize + 0;
    $data{"buffer"}->{"lastlines"} = [];
    $data{"buffer"}->{"lastinputs"} = [];

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

      push @{$data{"buffer"}->{"lastlines"}}, $input_buffer[$i];

      if (defined($input_sources[$i])) {
        push @{$data{"buffer"}->{"lastinputs"}}, $input_sources[$i];
      } else {
        push @{$data{"buffer"}->{"lastinputs"}}, "synthetic event";
      }
    }

  } else {

    $data{"buffer"}->{"bufmode"} = "separate buffer for each input source";
    $data{"buffer"}->{"bufsize"} = $bufsize + 0;
    $data{"buffer"}->{"lastlines"} = {};

    foreach $file (keys %input_buffers) {

      $data{"buffer"}->{"lastlines"}->{$file} = [];

      for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1;
           $i <= $input_buffers{$file}->{"BufPos"}; ++$i) {
        push @{$data{"buffer"}->{"lastlines"}->{$file}},
             $input_buffers{$file}->{"Events"}->[$i];
      }
    }

    $data{"buffer"}->{"lastsynevents"} = [];

    for ($i = $event_buffer{"BufPos"} - $bufsize + 1;
         $i <= $event_buffer{"BufPos"}; ++$i) {
      push @{$data{"buffer"}->{"lastsynevents"}},
           $event_buffer{"Events"}->[$i];
    }
  }

  # content of pending event buffer

  $i = 0;
  $data{"pendingevents"} = [];

  foreach $ref (@pending_events) {
    $data{"pendingevents"}->[$i] = {};
    $data{"pendingevents"}->[$i]->{"event"} = $ref->[1];
    $data{"pendingevents"}->[$i]->{"time"} = $ref->[0] + 0;
    if ($intcontexts) {
      $data{"pendingevents"}->[$i]->{"context"} = $ref->[2];
    }
    ++$i;
  }

  # content of pattern match cache

  $data{"pmatchcache"} = \%pmatch_cache;

  # list of active event correlation operations

  $data{"operations"} = {};

  while (($key, $ref) = each(%corr_list)) {
    $data{"operations"}->{$key} = {};
    convert_operation($data{"operations"}->{$key}, $key, $ref);
  }

  # list of active contexts

  $i = 0;
  %reported_names = ();
  $data{"contexts"} = [];

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

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

    $data{"contexts"}->[$i]->{"name"} = [ keys %{$ref->{"Aliases"}} ];

    foreach $name (keys %{$ref->{"Aliases"}}) {
      $reported_names{$name} = 1;
    }

    $data{"contexts"}->[$i]->{"creationtime"} = $ref->{"Time"} + 0;
    $data{"contexts"}->[$i]->{"lifetime"} = $ref->{"Window"} + 0;

    if (scalar(@{$ref->{"Action"}})) {
      $data{"contexts"}->[$i]->{"action"} = actionlist2str($ref->{"Action"});
    }

    $data{"contexts"}->[$i]->{"buffer"} = $ref->{"Buffer"};

    ++$i;
  }

  # list of running children

  $data{"children"} = {};

  while (($key, $ref) = each(%children)) {
    $data{"children"}->{$key} = {};
    $data{"children"}->{$key}->{"pid"} = $key + 0;
    $data{"children"}->{$key}->{"cmdline"} = $ref->{"cmd"};
    if ($ref->{"open"}) {
      $data{"children"}->{$key}->{"status"} = "Connected to pipe input";
      if ($intcontexts && exists($ref->{"context"}))
        { $data{"children"}->{$key}->{"context"} = $ref->{"context"}; }
    }
  }

  # values of action list variables

  $data{"variables"} = \%variables;

  # The 'allow_unknown' option will convert unexpected values
  # (such as code references held by action list variables) to json
  # null values (without this option encode() will croak). Also,
  # the 'utf8' option will generate json in utf8 format.

  $json = eval { JSON::PP->new->utf8->allow_unknown->encode(\%data) };

  if ($@) {
    log_msg(LOG_ERR, "Can't create JSON data for dumpfile ($@)");
    close($dhandle);
    return;
  }

  if (defined($json))  { print $dhandle $json; }

  close($dhandle);

  log_msg(LOG_DEBUG, "Dump to $dfilename completed");
}


##############################################################
# Functions related to IO handling and input buffer management
##############################################################


# Parameters: par1 - reference to input buffer
#             par2 - read-write pointer of input buffer
# Action: if the input buffer contains no data, initialize it;
#         if its size has changed, rearrange buffer data and return
#         the new read-write pointer

sub arrange_input_buffer {

  my($buffer, $bufptr) = @_;
  my($cursize, $i, $diff);

  $cursize = scalar(@{$buffer});

  # if the buffer length is zero, it needs initialization

  if ($cursize == 0) {
    for ($i = 0; $i < $bufsize; ++$i)  { $buffer->[$i] = ""; }
    return $bufsize - 1;
  }

  # if the buffer contains data and the buffer size has not changed,
  # leave the buffer intact

  if ($cursize == $bufsize)  { return $bufptr; }

  # if the buffer size has increased or decreased, shift the elements
  # so that the earliest has index 0 and the latest (buffersize - 1)

  @{$buffer} = @{$buffer}[$bufptr - $cursize + 1 .. $bufptr];

  # if the buffer size has decreased by K, remove K earliest elements;
  # if the buffer size has increased by K, add K elements

  if ($cursize > $bufsize) {
    $diff = $cursize - $bufsize;
    for ($i = 0; $i < $diff; ++$i)  { shift @{$buffer}; }
  } else {
    $diff = $bufsize - $cursize;
    for ($i = 0; $i < $diff; ++$i)  { unshift @{$buffer}, ""; }
  }

  return $bufsize - 1;

}


# Parameters: -
# Action: arrange all input buffers

sub arrange_input_buffers {

  my($inputfile);

  # create or resize the main input buffer and the list of input sources
  # (they share a common read-write pointer, so it needs setting once)

  arrange_input_buffer(\@input_buffer, $bufpos);
  $bufpos = arrange_input_buffer(\@input_sources, $bufpos);

  # with --jointbuf command line option, run SEC with joint input buffer
  # for all input sources, otherwise set up separate buffers

  if ($jointbuf) {

    %input_buffers = ();
    %event_buffer = ();

  } else {

    # create or resize the input buffer for synthetic events

    if (!exists($event_buffer{"BufPos"})) {
      $event_buffer{"Events"} = [];
      $event_buffer{"BufPos"} = 0;
    }

    $event_buffer{"BufPos"} =
      arrange_input_buffer($event_buffer{"Events"}, $event_buffer{"BufPos"});

    # remove input buffers for sources which are no longer monitored

    foreach $inputfile (keys %input_buffers) {
      if (!exists($inputsrc{$inputfile})) { delete $input_buffers{$inputfile}; }
    }

    # create or resize the input buffer for each input source

    foreach $inputfile (@inputfiles) {

      if (!exists($input_buffers{$inputfile})) {
        $input_buffers{$inputfile} = {};
        $input_buffers{$inputfile}->{"Events"} = [];
        $input_buffers{$inputfile}->{"BufPos"} = 0;
      }

      $input_buffers{$inputfile}->{"BufPos"} =
        arrange_input_buffer($input_buffers{$inputfile}->{"Events"},
                             $input_buffers{$inputfile}->{"BufPos"});
    }
  }
}


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

sub internal_event {

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

  $intcontextname = SECEVENT_INT_CONTEXT;

  log_msg(LOG_INFO, "Creating SEC internal context '$intcontextname'");

  $int_context->{"Aliases"}->{$intcontextname} = 1;
  $context_list{$intcontextname} = $int_context;

  log_msg(LOG_INFO, "Creating SEC internal event '$text'");

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

  if (!$jointbuf) {
    $event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize;
    $event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $text;
  }

  %pmatch_cache = ();

  foreach $conffile (@maincfiles) {
    if (process_rules($conffile)) { last; }
  }

  ++$processedlines;

  log_msg(LOG_INFO, "Deleting SEC internal context '$intcontextname'");

  delete $context_list{$intcontextname};
  delete $int_context->{"Aliases"}->{$intcontextname};
  $intcontextname = undef;

}


# Parameters: par1 - process ID
#             par2 - 'read all' flag
# Action: read available data from the pipe of process par1 and create events
#         from the data. If par2 is defined and non-zero, the function will
#         keep reading until all available data have been consumed, otherwise
#         the function will read once. The function will return the number
#         bytes read from the pipe.

sub consume_pipe {

  my($pid, $read_all) = @_;
  my($rin, $ret, $pos, $nbytes, $total, $event);

  $total = 0;

  for (;;) {

    # poll the pipe with select()

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

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

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

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

      log_msg(LOG_ERR,
              "Process $pid pipe select error ($!), closing the pipe");
      close($children{$pid}->{"fh"});
      $children{$pid}->{"open"} = 0;
      last;

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

    # try to read from the pipe

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

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

    if (!defined($nbytes)) {

      if ($! != EINTR) {

        log_msg(LOG_ERR, "Process $pid pipe IO error ($!), closing the pipe");
        close($children{$pid}->{"fh"});
        $children{$pid}->{"open"} = 0;
        last;

      }

    } elsif ($nbytes == 0) {

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

    } else { $total += $nbytes; }

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

    for (;;) {

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

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

      log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)");
      push @events, $event, $children{$pid}->{"context"};

    }

    if (!$read_all)  { last; }

  }

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

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

    $event = $children{$pid}->{"buffer"};
    log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)");
    push @events, $event, $children{$pid}->{"context"};

  }

  return $total;

}


# Parameters: -
# Action: check the status of SEC child processes, and read their standard
#         output if the event buffer is empty (unprocessed data from an exited
#         process will be appended to the event buffer unconditionally).
#         If at least one child process returns some bytes, return 1 (even
#         if these bytes do not constitute a full line), otherwise return 0

sub check_children {

  my($pid, $exitcode, $newdata);

  $newdata = 0;

  # Check all child processes that have been started by '*spawn' actions
  # for input data. If the buffer of synthetic events is not empty, polling
  # of child processes is skipped. If new data from child standard output are
  # available through pipe, create synthetic events from the data (provided
  # that at least one complete line was read). If at least one child has
  # new data, raise the 'newdata' flag (even if incomplete line was read).

  if (!scalar(@events)) {
    while ($pid = each(%children)) {
      if ($children{$pid}->{"open"} && consume_pipe($pid)) { $newdata = 1; }
    }
  }

  # get the exit status of every terminated child process.

  for (;;) {

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

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

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

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

      # find the child exit code

      $exitcode = $? >> 8;

      # if the terminated child was started with the '*spawn' action and
      # its pipe is still open, read all available data from the pipe

      if ($children{$pid}->{"open"} && consume_pipe($pid, 1)) { $newdata = 1; }

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

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

        log_msg(LOG_DEBUG, "Child $pid terminated with exitcode 0");

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

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

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

        log_msg(LOG_DEBUG,
                "Child $pid terminated with non-zero exitcode $exitcode");

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

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

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

      delete $children{$pid};

    }

  }

  return $newdata;

}


# Parameters: par1 - reference to the socket hash table
#             par2 - textual peer type
# Action: Check established connections in table par1 that holds TCP or unix
#         stream sockets, in order to detect connections that have been closed
#         by remote peers or have errors. Textual peer type par2 is used in
#         log messages about connections that are closed or have errors.

sub check_established_conns {

  my($sockets, $peertype) = @_;
  my($peer, $ret, $buffer, $nbytes, $total);

  # communication errors with peers are logged at the debug level,
  # in order to prevent message floods with higher severity when large
  # amounts of data are transfered

  foreach $peer (keys %{$sockets}) {

    $total = 0;

    for (;;) {

      # check if socket is ready for reading; if no data are available
      # for reading, quit the read-loop

      if (!socket_ready($sockets->{$peer}, 0))  { last; }

      # if data are available, try to receive data from socket

      $ret = recv($sockets->{$peer}, $buffer, $blocksize, 0);
      $nbytes = length($buffer);

      # if recv() failed because of the caught signal, try polling and
      # receiving again; if recv() failed because of other error, close the
      # socket and quit the read-loop; if recv() returned 0, it indicates
      # EOF (connection has been closed), so close the socket;
      # otherwise stop receiving if more than threshold bytes have been read

      if (!defined($ret)) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_DEBUG, "Connection error to $peertype '$peer' ($!)");
        delete $sockets->{$peer};
        last;
      }
      elsif ($nbytes == 0) {
        log_msg(LOG_DEBUG, "Connection to $peertype '$peer' closed by peer");
        delete $sockets->{$peer};
        last;
      }
      else { $total += $nbytes; }

      if ($total >= BATCHREADLIMIT)  { last; }
    }

  }
}


# Parameters: par1 - name of the input file
#             par2 - file offset
# Action: Input file will be opened and file offset will be moved to
#         offset par2 (-1 means "seek EOF" and 0 means "don't seek at all").
#         Return the filehandle, device ID, inode number, and file type flag
#         for the input file if open succeeded; otherwise return 'undef'.

sub open_input_file {

  my($file, $fpos) = @_;
  my($input, $flags, $regfile, @stat);

  # if input is stdin, duplicate it

  if ($file eq "-") {

    if ($WIN32) {
      log_msg(LOG_ERR, "Stdin is not supported as input on Win32");
      return undef;
    }

    while (!open($input, "<&STDIN")) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_ERR, "Can't dup stdin ($!)");
      return undef;
    }

  }

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

  elsif (-f $file) {

    while (!sysopen($input, $file, O_RDONLY)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_ERR, "Can't open input file $file ($!)");
      return undef;
    }

  }

  # if input file is a named pipe, open it in the mode specified with
  # the -rwfifo option (read-write or read-only nonblocking)

  elsif (-p $file) {

    if ($WIN32) {
      log_msg(LOG_ERR, "Named pipe is not supported as input on Win32");
      return undef;
    }

    if ($rwfifo)  { $flags = O_RDWR; }  else { $flags = O_RDONLY | O_NONBLOCK; }

    while (!sysopen($input, $file, $flags)) {
      if ($! == EINTR)  { next; }
      log_msg(LOG_ERR, "Can't open input file $file ($!)");
      return undef;
    }

  }

  # if input file does not exist, log a debug message if -reopen_timeout
  # option was given, otherwise log a warning message

  elsif (! -e $file) {

    if ($reopen_timeout) {
      log_msg(LOG_DEBUG, "Input file $file has not been created yet");
    } else {
      log_msg(LOG_WARN, "Input file $file does not exist!");
    }

    return undef;

  }

  # input file is of unsupported type

  else {
    log_msg(LOG_ERR, "Input file $file is of unsupported type!");
    return undef;
  }

  # if the input is not standard input, find the device id and inode number
  # for the opened filehandle

  if ($file ne "-") {

    for (;;) {
      @stat = stat($input);
      if (scalar(@stat))  { last; }
      if ($! == EINTR)  { next; }
      log_msg(LOG_ERR, "Can't stat input file $file through filehandle ($!)");
      close($input);
      return undef;
    }

  } else { @stat = ("-", "-"); }

  # If input filehandle is connected to a regular file, set the file type
  # flag to 1. Also, if $fpos == -1 or $fpos > 0, seek the given offset
  # in the file. If $fpos is greater than the file size, EOF will be seeked.

  if (-f $input) {

    if ($fpos > $stat[7]) {
      log_msg(LOG_NOTICE,
              "Offset $fpos beyond EOF, seeking EOF in input file $file");
      $fpos = -1;
    }

    if ($fpos == -1) {

      while (!sysseek($input, 0, SEEK_END)) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_ERR, "Can't seek EOF in input file $file ($!)");
        close($input);
        return undef;
      }

    } elsif ($fpos > 0) {

      while (!sysseek($input, $fpos, SEEK_SET)) {
        if ($! == EINTR)  { next; }
        log_msg(LOG_ERR, "Can't seek offset $fpos in input file $file ($!)");
        close($input);
        return undef;
      }

    }

    $regfile = 1;

  } else { $regfile = 0; }

  return ($input, $stat[0], $stat[1], $regfile);

}


# Parameters: par1 - file offset
#             par2 - flag (optional)
# Action: evaluate the inputfile patterns given in commandline, form the
#         list of inputfiles and save it to global array @inputfiles. Each
#         input file will then be opened and file offset will be moved to
#         offset par1 (-1 means "seek EOF" and 0 means "don't seek at all").
#         If -intcontexts option is active, also set up internal contexts.
#         If flag par2 is set, input files which are already open will not
#         be closed and reopened, and their status data will be retained
#         (par2 reflects the value of the -keepopen command line option)

sub open_input {

  my($fpos, $softopen) = @_;
  my($filepat, $pattern, $cmdline_context);
  my(%fcont, $inputfile, $time);
  my($fh, $dev, $inode, $regfile, $i, $j, @buf);

  # If $softopen is set, status data of already open input files must be
  # retained and files must be kept open (note that $softopen reflects
  # the value of the -keepopen command line option)
  # In the case of full open, clean global arrays %inputsrc and @readbuffer
  # (the keys for %inputsrc are members of global array @inputfiles).
  # Note that dropping all data in %inputsrc will implicitly close all input
  # file handles.

  if (!$softopen) {
    %inputsrc = ();
    @readbuffer = ();
  }

  # Find the input file names and file contexts

  %fcont = ();

  foreach $filepat (@inputfilepat) {

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

    if ($filepat =~ /^(.+)=(\S+)$/) {
      $pattern = $1;
      $cmdline_context = $2;
      $intcontexts = 1;
    } else {
      $pattern = $filepat;
      $cmdline_context = undef;
    }

    # interpret the pattern and store file-context pairs into %fcont
    # (if a file is given more than once in the command line, the last
    # definition will override previous ones)

    foreach $inputfile (glob($pattern)) {
      $fcont{$inputfile} = defined($cmdline_context)?$cmdline_context:
                           (FILEVENT_INT_CONTEXT_PREF . $inputfile);
    }

  }

  # Merge dynamic input files with input files provided in command line

  foreach $inputfile (keys %dyninputfiles) {
    if (exists($fcont{$inputfile})) {
      log_msg(LOG_NOTICE, "Dynamic input file", $inputfile,
        "has been provided in command line and is no longer regarded dynamic");
      delete $dyninputfiles{$inputfile};
    } else {
      $fcont{$inputfile} = $dyninputfiles{$inputfile};
    }
  }

  # Open the input files

  @inputfiles = sort keys %fcont;
  $time = time();

  foreach $inputfile (@inputfiles) {

    log_msg(LOG_NOTICE, "Opening input file $inputfile");

    # in the case of soft open, check if we already have status data
    # for the input file in memory; if the file is open, update the file
    # context, but retain all other status data and skip the open

    if ($softopen  &&  exists($inputsrc{$inputfile})  &&
        $inputsrc{$inputfile}->{"open"}) {
      log_msg(LOG_DEBUG, "Input file $inputfile already open");
      $inputsrc{$inputfile}->{"context"} = $fcont{$inputfile};
      next;
    }

    # in all other cases reopen the input file and (re)initialize its
    # status data; note that if the file was previously open, recreating
    # its entry in %inputsrc will close the previous file handle implicitly,
    # since it is no longer referenced

    ($fh, $dev, $inode, $regfile) = open_input_file($inputfile, $fpos);

    $inputsrc{$inputfile} = { "fh" => $fh,
                              "open" => defined($fh),
                              "dev" => $dev,
                              "inode" => $inode,
                              "regfile" => $regfile,
                              "buffer" => "",
                              "scriptexec" => 0,
                              "checktime" => 0,
                              "lastopen" => $time,
                              "lastread" => $time,
                              "lines" => 0,
                              "context" => $fcont{$inputfile} };

    # if the input file open failed because of the missing file, set the
    # "read_from_start" flag which enforces reading from the beginning
    # when the file will appear and another open will be attempted

    if (!defined($fh)  &&  $inputfile ne "-"  &&  ! -e $inputfile) {
      $inputsrc{$inputfile}->{"read_from_start"} = 1;
    }

  }

  # In the case of soft open, delete %inputsrc and @readbuffer entries for
  # past input files which no longer match any input file pattern.
  # This step does not need to be carried out for full open, since %inputsrc
  # and @readbuffer are cleared before open. Note that deleting entries for
  # past input files will implicitly close all open file handles for them.

  if ($softopen) {

    foreach $inputfile (keys %inputsrc) {
      if (!exists($fcont{$inputfile}))  { delete $inputsrc{$inputfile}; }
    }

    @buf = ();
    $j = scalar(@readbuffer);

    for ($i = 0; $i < $j; $i += 2) {
      if (!exists($fcont{$readbuffer[$i+1]}))  { next; }
      push @buf, $readbuffer[$i], $readbuffer[$i+1];
    }

    @readbuffer = @buf;
  }

}


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

sub input_shuffled {

  my($file) = $_[0];
  my(@stat, @stat2, $fpos, $bytes);

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

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

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

  @stat = stat($file);

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

  # if the input file is a regular file, get the current read offset

  if ($inputsrc{$file}->{"regfile"}) {
    for (;;) {
      $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR);
      if (defined($fpos))  { last; }
      if ($! == EINTR)  { next; }
      log_msg(LOG_ERR,
        "Can't seek filehandle of input file $file ($!), closing the file");
      close($inputsrc{$file}->{"fh"});
      $inputsrc{$file}->{"open"} = 0;
      return undef;
    }
  }

  # Check if device or inode numbers of filehandle and input file match
  # (this check will be skipped on Windows). If numbers don't match and
  # filehandle refers to a regular file, find the size of the file and if
  # read offset is smaller, read remaining bytes into file's IO buffer.

  if (!$WIN32 &&
      ($inputsrc{$file}->{"dev"} != $stat[0] ||
       $inputsrc{$file}->{"inode"} != $stat[1])) {

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

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

      if (scalar(@stat2)) {
        $bytes = $stat2[7] - $fpos;
      } else {
        $bytes = 0;
      }

      if ($bytes > 0) {
        sysread($inputsrc{$file}->{"fh"}, $inputsrc{$file}->{"buffer"},
                $bytes, length($inputsrc{$file}->{"buffer"}));
      }
    }

    log_msg(LOG_NOTICE, "Input file $file has been recreated");
    return 1;
  }

  # If input file is a regular file, check if file size has decreased

  if ($inputsrc{$file}->{"regfile"}  &&  $fpos > $stat[7]) {
    log_msg(LOG_NOTICE, "Input file $file has been truncated");
    return 1;
  }

  return 0;

}


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

sub read_line_from_file {

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

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

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

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

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

    # try to read data from a regular file

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

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

    if (!defined($nbytes)) {

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

      if ($! != EINTR) {

        log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file");

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

        return undef;

      }

    } elsif ($nbytes == 0) {

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

      if ($tail)  { return undef; }

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

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

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

    }

  } else {

    # poll the input pipe for new data with select(); if pipe contains
    # no data or polling yields an error, return undef

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

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

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

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

      log_msg(LOG_ERR,
              "Input pipe $file select error ($!), closing the pipe");

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

      return undef;

    } elsif ($ret == 0)  { return undef; }

    # try to read from the pipe

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

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

    if (!defined($nbytes)) {

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

      if ($! != EINTR) {

        log_msg(LOG_ERR, "Input pipe $file IO error ($!), closing the pipe");

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

        return undef;

      }

    } elsif ($nbytes == 0) {

      # If sysread() returns 0, there are no writers on the pipe anymore,
      # and from now on select() always claims that EOF is available for
      # reading (in -rwfifo mode, this should never happen for a named pipe,
      # since there is always at least one writer on the pipe).
      # If the pipe is a named pipe and -tail mode is active, reopen the pipe;
      # if the pipe represents standard input or -notail mode is active, close
      # the pipe. If the file buffer is not empty, return its content (bytes
      # between the last newline in the file and EOF), otherwise return undef.
      # Log messages about close and reopen at the debug level, in order to
      # prevent message floods when writer closes the pipe after each write.

      log_msg(LOG_DEBUG, "No writers on input pipe $file, closing the pipe");

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

      if ($tail  &&  $file ne "-") {

        log_msg(LOG_DEBUG, "Reopening input pipe $file");

        ($inputsrc{$file}->{"fh"},
         $inputsrc{$file}->{"dev"},
         $inputsrc{$file}->{"inode"},
         $inputsrc{$file}->{"regfile"}) = open_input_file($file, -1);

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

      }

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

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

    }

  }

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

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

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

  return undef;

}


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

sub read_line {

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

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

  $newdata = 0;
  $time = time();

  foreach $file (@inputfiles) {

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

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

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

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

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

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

    if (defined($line)) {

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

      push @readbuffer, $line, $file;

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

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

        log_msg(LOG_INFO,
                "Input received, executing script $timeout_script 0 $file");

        exec_cmd([$timeout_script, 0, $file]);
        $inputsrc{$file}->{"scriptexec"} = 0;

      }

    }

    else {

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

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

      # if -check_timeout is set, poll the file after $check_timeout seconds

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

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

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

        log_msg(LOG_INFO,
                "No input, executing script $timeout_script 1 $file");

        exec_cmd([$timeout_script, 1, $file]);
        $inputsrc{$file}->{"scriptexec"} = 1;

      }

      # if there were no new bytes in the input file and -notail mode
      # is active, skip shuffle and reopen timeout checks

      if (!$tail)  { next; }

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

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

        log_msg(LOG_NOTICE, "Reopening $file and processing from the start");

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

        ($inputsrc{$file}->{"fh"},
         $inputsrc{$file}->{"dev"},
         $inputsrc{$file}->{"inode"},
         $inputsrc{$file}->{"regfile"}) = open_input_file($file, 0);

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

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

      }

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

      if ($reopen_timeout  &&  !$inputsrc{$file}->{"open"}  &&
          $time - $inputsrc{$file}->{"lastopen"} >= $reopen_timeout) {

        log_msg(LOG_DEBUG, "Attempting to (re)open $file");

        if (exists($inputsrc{$file}->{"read_from_start"})) {

          ($inputsrc{$file}->{"fh"},
           $inputsrc{$file}->{"dev"},
           $inputsrc{$file}->{"inode"},
           $inputsrc{$file}->{"regfile"}) = open_input_file($file, 0);

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

        } else {

          ($inputsrc{$file}->{"fh"},
           $inputsrc{$file}->{"dev"},
           $inputsrc{$file}->{"inode"},
           $inputsrc{$file}->{"regfile"}) = open_input_file($file, -1);

        }

        $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"});
        $inputsrc{$file}->{"lastopen"} = $time;

      }

    }

  }

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

  if (scalar(@readbuffer)) {
    $_[0] = shift @readbuffer;
    $_[1] = shift @readbuffer;
  } else {
    $_[0] = undef;
    $_[1] = $newdata;
  }

}


# Parameters: -
# Action: close all output files and sockets, and drop related data structures
#         (dropping all filehandles from memory forces them to be closed)

sub close_outputs {

  %output_files = ();

  %output_udgram = ();

  %output_ustrconn = ();
  %output_ustream = ();

  %output_udpsock = ();

  %output_tcpconn = ();
  %output_tcpsock = ();
}


###################################################
# Functions related to signal reception and sending
###################################################


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

sub check_signals {

  my($file, @file_list, @keys, $templevel);

  # if SIGHUP has arrived, do a full restart of SEC

  if ($refresh) {

    log_msg(LOG_NOTICE, "SIGHUP received: full restart of SEC");

    # if -intevents flag was specified, generate the SEC_PRE_RESTART event

    if ($intevents)  { internal_event("SEC_PRE_RESTART"); }

    # close all output files and sockets

    close_outputs();

    # terminate child processes

    if ($childterm)  { child_cleanup(); }

    # clear correlation operations, contexts and action list variables

    %corr_list = ();
    %context_list = ();
    %variables = ();

    # clear pending events

    @pending_events = ();

    # drop the names of dynamic input files (they will be closed when
    # open_input() is called later in this function)

    %dyninputfiles = ();

    # close the logfile and connection to the system logger

    if ($logopen)  { close($loghandle); $logopen = 0; }
    if ($syslogopen)  { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }

    # re-read SEC command line and resource file options

    read_options();

    # open the logfile and connection to the system logger

    if (defined($logfile))  { open_logfile($logfile); }
    if (defined($syslogf))  { open_syslog($syslogf); }

    # read configuration from SEC rule files

    read_config();

    # if --bufsize command line option has not been provided or --bufsize=0,
    # set --bufsize by analyzing loaded rules

    if (!$bufsize)  { set_bufsize_option(); }

    # (re)open all input sources and arrange input buffers

    open_input(-1);
    arrange_input_buffers();

    # since all action list variables have been dropped, re-create builtin
    # action list variables for the current second and special characters

    $timevar_update = time();
    set_actionlist_time_var($timevar_update);
    set_actionlist_char_var();

    # if -intevents flag was specified, generate the SEC_RESTART event

    if ($intevents)  { internal_event("SEC_RESTART"); }

    # set the signal flag back to zero

    $refresh = 0;

  }

  # if SIGABRT has arrived, do a soft restart of SEC

  if ($softrefresh) {

    log_msg(LOG_NOTICE, "SIGABRT received: soft restart of SEC");

    # if -intevents flag was specified, generate the SEC_PRE_SOFTRESTART event

    if ($intevents)  { internal_event("SEC_PRE_SOFTRESTART"); }

    # close all output files and sockets

    close_outputs();

    # close the logfile and connection to the system logger

    if ($logopen)  { close($loghandle); $logopen = 0; }
    if ($syslogopen)  { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }

    # re-read SEC command line and resource file options

    read_options();

    # open the logfile and connection to the system logger

    if (defined($logfile))  { open_logfile($logfile); }
    if (defined($syslogf))  { open_syslog($syslogf); }

    # read configuration from SEC rule files that are either new or
    # have been modified, and store to the array @file_list the names
    # of files that have been modified or removed

    soft_read_config(\@file_list);

    # if --bufsize command line option has not been provided or --bufsize=0,
    # set --bufsize by analyzing loaded rules

    if (!$bufsize)  { set_bufsize_option(); }

    # clear event correlation operations related to the modified and
    # removed configuration files

    foreach $file (@file_list) {
      @keys = grep($corr_list{$_}->{"File"} eq $file, keys %corr_list);
      log_msg(LOG_DEBUG,
        "Terminating all event correlation operations started from $file,",
        "number of operations:", scalar(@keys));
      delete @corr_list{@keys};
    }

    # if -keepopen flag was specified, close old and open new input sources,
    # otherwise (re)open all input sources; also, arrange input buffers

    open_input(-1, $keepopen);
    arrange_input_buffers();

    # if -intevents flag was specified, generate the SEC_SOFTRESTART event

    if ($intevents)  { internal_event("SEC_SOFTRESTART"); }

    # set the signal flag back to zero

    $softrefresh = 0;

  }

  # if SIGUSR1 has arrived, create the dump file

  if ($dumpdata) {

    log_msg(LOG_NOTICE, "SIGUSR1 received: dumping performance and debug data");

    # write info about SEC state to the dump file

    if ($dumpfjson)  { dump_data_json(); }  else { dump_data(); }

    # set the signal flag back to zero

    $dumpdata = 0;

  }

  # if SIGUSR2 has arrived, restart logging

  if ($openlog) {

    log_msg(LOG_NOTICE,
            "SIGUSR2 received: closing outputs and restarting logging");

    # if -intevents flag was specified, generate the SEC_PRE_LOGROTATE event

    if ($intevents)  { internal_event("SEC_PRE_LOGROTATE"); }

    # close all output files and sockets

    close_outputs();

    # reopen the logfile and connection to the system logger

    if ($logopen)  { close($loghandle); $logopen = 0; }
    if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; }

    if (defined($logfile))  { open_logfile($logfile); }
    if (defined($syslogf))  { open_syslog($syslogf); }

    # if -intevents flag was specified, generate the SEC_LOGROTATE event

    if ($intevents)  { internal_event("SEC_LOGROTATE"); }

    # set the signal flag back to zero

    $openlog = 0;

  }

  # if SIGINT has arrived, set the debug level to a new value; also, log
  # a message without level, so that it would always appear in the log

  if ($debuglevelinc) {

    $templevel = ($debuglevel + $debuglevelinc - 1) % 6 + 1;

    log_msg(LOG_WITHOUT_LEVEL, $debuglevelinc, "SIGINT signal(s) received:",
            "setting debuglevel from $debuglevel to $templevel");

    $debuglevel = $templevel;

    # set the signal counter back to zero

    $debuglevelinc = 0;

  }

  # if SIGTERM has arrived, shutdown SEC

  if (exists($terminate{$$})) {

    log_msg(LOG_NOTICE, "SIGTERM received: shutting down SEC");

    # If -intevents flag was specified, generate the SEC_SHUTDOWN event.
    # After generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT
    # seconds, so that child processes that were triggered by SEC_SHUTDOWN
    # have time to create a signal handler for SIGTERM if they wish.

    if ($intevents) {
      internal_event("SEC_SHUTDOWN");
      if ($childterm)  { sleep(TERMTIMEOUT); }
    }

    # final shutdown procedures

    if ($childterm)  { child_cleanup(); }
    exit(0);

  }

}


# Parameters: -
# Action: detect if SIGINT can be used for changing logging levels

sub override_sigint {

  my($tty, $fh, $tcpgrp, $pgrp);

  # if the process is started as a daemon, override SIGINT
  if ($detach)  { return 1; }

  # on Windows platform, do not override SIGINT
  if ($WIN32)  { return 0; }

  # if the process was not started as a daemon, get the name of the special
  # file which points to the controlling terminal of the process (should be
  # /dev/tty on most platforms); if opening the special file fails, the
  # process has no controlling terminal, and override SIGINT

  $tty = POSIX::ctermid();
  if (!open($fh, $tty))  { return 1; }

  # get group ID of the current process, and the group ID of the foreground
  # process at the controlling terminal; if the ID's are different, current
  # process is not running on foreground, and override SIGINT

  $pgrp = POSIX::getpgrp();

  if (!defined($pgrp)) {
    log_msg(LOG_ERR, "Can't get process group ID ($!)");
    return 0;
  }

  $tcpgrp = POSIX::tcgetpgrp(fileno($fh));

  if (!defined($tcpgrp)) {
    log_msg(LOG_ERR, "Can't get foreground process group ID ($!)");
    return 0;
  }

  close($fh);

  return ($pgrp != $tcpgrp);

}


# Parameters: -
# Action: terminate child processes

sub child_cleanup {

  my($pid, $p);

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

    $p = waitpid($pid, WNOHANG);

    # exit status of a terminated process has been already fetched with waitpid(),
    # but the process is still present in the %children hash (should never happen)

    if ($p == -1) {
      delete $children{$pid};
      next;
    }

    # according to the current call to waitpid(), the process has terminated

    if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) {
      delete $children{$pid};
      next;
    }

    # the process is running

    log_msg(LOG_NOTICE, "Sending SIGTERM to process $pid");
    kill('TERM', $pid);
  }

}


# Parameters: -
# Action: on arrival of SIGHUP set flag $refresh

sub hup_handler {

  $SIG{HUP} = \&hup_handler;
  $refresh = 1;
  $sigreceived = 1;
}


# Parameters: -
# Action: on arrival of SIGABRT set flag $softrefresh

sub abrt_handler {

  $SIG{ABRT} = \&abrt_handler;
  $softrefresh = 1;
  $sigreceived = 1;
}


# Parameters: -
# Action: on arrival of SIGUSR1 set flag $dumpdata

sub usr1_handler {

  $SIG{USR1} = \&usr1_handler;
  $dumpdata = 1;
  $sigreceived = 1;
}


# Parameters: -
# Action: on arrival of SIGUSR2 set flag $openlog

sub usr2_handler {

  $SIG{USR2} = \&usr2_handler;
  $openlog = 1;
  $sigreceived = 1;
}


# Parameters: -
# Action: on arrival of SIGINT set flag $debuglevelinc

sub int_handler {

  $SIG{INT} = \&int_handler;
  ++$debuglevelinc;
  $sigreceived = 1;
}


# Parameters: -
# Action: on arrival of SIGTERM set a flag for the current process ID

sub term_handler {

  $SIG{TERM} = \&term_handler;
  $terminate{$$} = 1;
  $sigreceived = 1;
}


########################################################
# Functions related to daemonization, pid file creation,
# setting the user and group ID, and option processing
########################################################


# Parameters: -
# Action: daemonize the process

sub daemonize {

  local $SIG{HUP} = 'IGNORE'; # ignore SIGHUP inside this function
  my($pid);

  # -detach is not supported on Windows

  if ($WIN32) {
    log_msg(LOG_CRIT, "'--detach' option is not supported on Win32");
    exit(1);
  }

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

  if (grep($_ eq "-", @inputfiles)) {
    log_msg(LOG_CRIT,
            "Can't become a daemon (stdin is specified as input), exiting!");
    exit(1);
  }

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

  $pid = fork();

  if (!defined($pid)) {
    log_msg(LOG_CRIT,
            "Can't fork a new process for daemonization ($!), exiting!");
    exit(1);
  }

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

  # create a new session and process group

  if (!POSIX::setsid()) {
    log_msg(LOG_CRIT, "Can't start a new session ($!), exiting!");
    exit(1);
  }

  # fork a second copy of the process and exit from the parent - the parent
  # as a session leader might deliver the SIGHUP signal to child when it
  # exits, but SIGHUP is ignored inside this function

  $pid = fork();

  if (!defined($pid)) {
    log_msg(LOG_CRIT,
            "Can't fork a new process for daemonization ($!), exiting!");
    exit(1);
  }

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

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

  if (!open(STDIN, '/dev/null')) {
    log_msg(LOG_CRIT, "Can't connect stdin to /dev/null ($!), exiting!");
    exit(1);
  }

  if (!open(STDOUT, '>/dev/null')) {
    log_msg(LOG_CRIT, "Can't connect stdout to /dev/null ($!), exiting!");
    exit(1);
  }

  if (!open(STDERR, '>&STDOUT')) {
    log_msg(LOG_CRIT,
            "Can't connect stderr to stdout with dup ($!), exiting!");
    exit(1);
  }

  log_msg(LOG_DEBUG, "Daemonization complete");

}


# Parameters: -
# Action: create the pid file for the process

sub create_pidfile {

  my($file) = $_[0];
  my($fh);

  if (open($fh, ">$file")) {
    print $fh "$$\n";
    close($fh);
  } else {
    log_msg(LOG_CRIT, "Can't open pidfile $file for writing ($!), exiting!");
    exit(1);
  }

}


# Parameters: par1 - effective group ID
#             par2, par3, .. - IDs of supplementary groups
# Action: set effective group ID to par1 and supplementary groups to
#         par1, par2, par3, etc. Return 1 if supplementary groups were
#         successfully set, 0 otherwise.

sub set_supplementary_groups {

  my($egid) = $_[0];
  my(@supp_gids) = @_;
  my(%gids, %result, @list, $gid);

  # since perl POSIX module lacks setgroups(), set the $) special variable
  # accordingly (the first element in the string must be effective group ID,
  # while the following elements define supplementary groups)

  $) = "$egid " . join(" ", @supp_gids);

  # to verify if setting supplementary groups succeeded, check $) variable
  # (note that $) can report the same supplementary group ID more than once)

  @list = split(' ', $) );

  # if effective group ID is not properly set, setting the groups has failed

  if ($egid != $list[0])  { return 0; }

  # since POSIX leaves it open whether effective group ID is reported in
  # the list of supplementary groups, create %result from all gids in $)

  %gids = map { $_ => 1 } @supp_gids;
  %result = map { $_ => 1 } @list;

  # verify that all requested groups are among supplementary groups

  foreach $gid (keys %gids) {
    if (!exists($result{$gid}))  { return 0; }
    delete $result{$gid};
  }

  # verify that other groups are not among supplementary groups

  if (scalar(%result))  { return 0; }

  return 1;

}


# Parameters: -
# Action: set the user and group ID, and exit if an error is encountered.
#         This function logs its error messages to standard error, since
#         the logfile has to be opened after a call to this function with
#         a new user and group ID.

sub set_user_and_group_id {

  my($userid, $groupid, $groupname, $gname, $gid);
  my(@pwinfo, %supp_gids);

  # --user and --group options are not supported on Windows

  if ($WIN32) {
    print STDERR "'--user' and '--group' options are not supported on Win32\n";
    exit(1);
  }

  # --user and --group options can be used if process is running with euid 0

  if ($>) {
    print STDERR "'--user' and '--group' options can only be used by root " .
                 "(current euid is not 0 but $>)\n";
    exit(1);
  }

  # find numerical ID for the user name provided with --user option

  @pwinfo = getpwnam($username);

  if (!scalar(@pwinfo)) {
    print STDERR "User name '$username' does not exist, exiting!\n";
    exit(1);
  }

  $userid = $pwinfo[2];

  if (!$userid) {
    print STDERR
    "Can't drop root privileges by setting user to '$username', exiting!\n";
    exit(1);
  }

  # Find numerical IDs for group names provided with --group options.
  # If several --group options were provided, the first group defines the
  # group ID. If no --group option was provided, group ID is set to the user's
  # primary group. Also, each group is treated as a supplementary group.

  %supp_gids = ();

  if (scalar(@groupnames)) {

    foreach $gname (@groupnames) {
      $gid = getgrnam($gname);
      if (!defined($gid)) {
        print STDERR "Group name '$gname' does not exist, exiting!\n";
        exit(1);
      }
      if (!scalar(%supp_gids)) {
        $groupname = $gname;
        $groupid = $gid;
      }
      $supp_gids{$gid} = $gname;
    }

  } else {

    $groupid = $pwinfo[3];
    $groupname = getgrgid($groupid);
    if (!defined($groupname)) {
      print STDERR "Group ID '$groupid' does not exist, exiting!\n";
      exit(1);
    }
    $supp_gids{$groupid} = $groupname;

  }

  # Set the group ID with setgid(). This must be done before changing
  # the user ID, since otherwise there might not be enough privileges for
  # successful setgid() call. Although setgid() behavior depends on
  # the platform (e.g., behavior on BSD and Linux is different), it always
  # sets the effective, real, and saved set-group ID if effective user ID
  # is 0 (verified above). Also note that some ancient versions of perl do
  # not return 'undef' if setgid() fails but rather the value of the $)
  # special variable. Therefore, we also check if both effective and real
  # group ID are properly set after setgid() has been called (the IDs are
  # first elements in strings provided by $) and $( variables).

  if (!POSIX::setgid($groupid) || (split(' ', $) ))[0] != $groupid
                               || (split(' ', $( ))[0] != $groupid) {
    print STDERR "Can't set group to '$groupname' ($!), exiting!\n";
    exit(1);
  }

  # set supplementary groups (this must be done before changing the user ID,
  # since otherwise there might not be enough privileges for that)

  if (!set_supplementary_groups($groupid, keys %supp_gids)) {
    print STDERR "Can't set supplementary groups to '" .
                 join(" ", values %supp_gids) . "', exiting!\n";
    exit(1);
  }

  # Set the user ID with setuid(). Although setuid() behavior depends on
  # the platform (e.g., behavior on BSD and Linux is different), it always
  # sets the effective, real, and saved set-user ID if effective user ID
  # is 0 (verified above). Also note that some ancient versions of perl do
  # not return 'undef' if setuid() fails but rather the value of the $>
  # special variable. Therefore, we also check if both effective and real
  # user ID ($> and $<) are properly set after setuid() has been called.

  if (!POSIX::setuid($userid) || $> != $userid || $< != $userid) {
    print STDERR "Can't set user to '$username' ($!), exiting!\n";
    exit(1);
  }

}


# Parameters: -
# Action: Set the file mode creation mask (if the current platform does
#         not support umask(2) system call, umask() returns undef).
#         This function logs its error messages to standard error, since
#         the logfile has to be opened after a call to this function with
#         a new umask.

sub set_umask {

  if (!defined(umask($umask))) {
    print STDERR "'--umask' option is not supported on this platform\n";
    exit(1);
  }

}


# Parameters: -
# Action: scan all rules loaded from configuration files, and set the
#         --bufsize command line option to the largest number of lines
#         configured with the ptype* field (e.g., if loaded rules have
#         fields ptype=RegExp2, ptype2=PerlFunc5, ptype=RegExp3, and
#         ptype=NSubStr4, assume --bufsize=5).

sub set_bufsize_option {

  my($conffile, $rule);
  my($type, $max, $i);

  # the function will always set --bufsize to at least 1, even if
  # no valid rules have been defined in configuration files

  $max = 1;

  # scan all loaded rules for finding the value for --bufsize

  foreach $conffile (@conffiles) {

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

      $type = $rule->{"Type"};

      if ($type == CALENDAR) { next; }

      elsif ($type == SINGLE || $type == SINGLE_W_SUPPRESS ||
             $type == SINGLE_W_SCRIPT || $type == SINGLE_W_THRESHOLD ||
             $type == SINGLE_W_2_THRESHOLDS || $type == SUPPRESS ||
             $type == JUMP) {

        if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; }

      }

      elsif ($type == PAIR || $type == PAIR_W_WINDOW) {

        if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; }
        if ($max < $rule->{"PatLines2"}) { $max = $rule->{"PatLines2"}; }

      }

      elsif ($type == EVENT_GROUP) {

        foreach $i (@{$rule->{"PatLinesList"}}) {
          if ($max < $i) { $max = $i; }
        }

      }
    }
  }

  log_msg(LOG_DEBUG, "No --bufsize command line option or --bufsize=0,",
                     "setting --bufsize to $max");
  $bufsize = $max;

  # in the case of --bufsize=1, always enable the --jointbuf option,
  # since there is no need to maintain multiple input buffers

  if ($bufsize == 1)  { $jointbuf = 1; }

}


# Parameters: -
# Action: read and process options from command line and resource file
#         (this function logs its error messages to standard error, since
#         logging is not activated when the function is called)

sub read_options {

  my(@argv_backup, @values, $option, $fh);

  # back up the @ARGV array

  @argv_backup = @ARGV;

  # open the file pointed by the SECRC environment variable and
  # read options from that file; empty lines and lines starting
  # with the #-symbol are ignored, rest of the lines are treated
  # as SEC command line options and pushed into @ARGV with
  # leading and trailing whitespace removed

  if (exists($ENV{"SECRC"})) {

    if (open($fh, $ENV{"SECRC"})) {

      while (<$fh>) {
        if (/^\s*(.*\S)/) {
          $option = $1;
          if (index($option, '#') == 0) { next; }
          push @ARGV, $option;
        }
      }

      close($fh);
      $rcfile_status = $ENV{"SECRC"};

    } else {
      print STDERR "Can't open resource file " . $ENV{"SECRC"} . " ($!)\n";
      $rcfile_status = $ENV{"SECRC"} . " - open failed ($!)";
    }

  } else { $rcfile_status = "none"; }

  # set the $sec_options global variable

  $sec_options = join(" ", @ARGV);

  # (re)set option variables to default values

  @conffilepat = ();
  @inputfilepat = ();
  $input_timeout = 0;
  $timeout_script = undef;
  $reopen_timeout = 0;
  $check_timeout = 0;
  $poll_timeout = DEFAULT_POLLTIMEOUT;
  $socket_timeout = DEFAULT_SOCKETTIMEOUT;
  $blocksize = DEFAULT_BLOCKSIZE;
  $bufsize = 0;
  $evstoresize = 0;
  $cleantime = DEFAULT_CLEANTIME;
  $logfile = undef;
  $syslogf = undef;
  $debuglevel = 6;
  $pidfile = undef;
  $dumpfile = DEFAULT_DUMPFILE;
  $username = undef;
  @groupnames = ();
  $umask = undef;
  $ruleperf = 0;
  $dumpfts = 0;
  $dumpfjson = 0;
  $quoting = 0;
  $tail = 1;
  $fromstart = 0;
  $detach = 0;
  $jointbuf = 0;
  $keepopen = 1;
  $rwfifo = 1;
  $childterm = 1;
  $intevents = 0;
  $intcontexts = 0;
  $testonly = 0;
  $help = 0;
  $version = 0;

  # parse the options given in command line and in SEC resource file
  # (GetOptions() prints parsing error messages to standard error)

  GetOptions( "conf=s" => \@conffilepat,
              "input=s" => \@inputfilepat,
              "input-timeout|input_timeout=i" => \$input_timeout,
              "timeout-script|timeout_script=s" => \$timeout_script,
              "reopen-timeout|reopen_timeout=i" => \$reopen_timeout,
              "check-timeout|check_timeout=i" => \$check_timeout,
              "poll-timeout|poll_timeout=f" => \$poll_timeout,
              "socket-timeout|socket_timeout=i" => \$socket_timeout,
              "blocksize=i" => \$blocksize,
              "bufsize=i" => \$bufsize,
              "evstoresize=i" => \$evstoresize,
              "cleantime=i" => \$cleantime,
              "log=s" => \$logfile,
              "syslog=s" => \$syslogf,
              "debug=i", \$debuglevel,
              "pid=s" => \$pidfile,
              "dump=s" => \$dumpfile,
              "user=s" => \$username,
              "group=s" => \@groupnames,
              "umask=o" => \$umask,
              "ruleperf!" => \$ruleperf,
              "dumpfts!" => \$dumpfts,
              "dumpfjson!" => \$dumpfjson,
              "quoting!" => \$quoting,
              "tail!" => \$tail,
              "fromstart!" => \$fromstart,
              "detach!" => \$detach,
              "jointbuf!" => \$jointbuf,
              "keepopen!" => \$keepopen,
              "rwfifo!" => \$rwfifo,
              "childterm!" => \$childterm,
              "intevents!" => \$intevents,
              "intcontexts!" => \$intcontexts,
              "testonly!" => \$testonly,
              "help|?" => \$help,
              "version" => \$version,
              "<>" => sub { print STDERR "Unknown argument: $_[0]\n"; } );

  # check the values received from command line and resource file
  # and set option variables back to defaults, if necessary

  @values = grep(length($_), @conffilepat);

  if (scalar(@values) < scalar(@conffilepat)) {
    print STDERR "'--conf' option requires a non-empty value\n";
    @conffilepat = @values;
  }

  @values = grep(length($_), @inputfilepat);

  if (scalar(@values) < scalar(@inputfilepat)) {
    print STDERR "'--input' option requires a non-empty value\n";
    @inputfilepat = @values;
  }

  if ($input_timeout < 0) {
    print STDERR "'--input-timeout' option requires a non-negative value\n";
    $input_timeout = 0;
  }

  if (defined($timeout_script) && !length($timeout_script)) {
    print STDERR "'--timeout-script' option requires a non-empty value\n";
    $timeout_script = undef;
  }

  if ($input_timeout > 0 && !defined($timeout_script)) {
    print STDERR
          "'--input-timeout' option requires the '--timeout-script' option\n";
    $input_timeout = 0;
  }

  if ($reopen_timeout < 0) {
    print STDERR "'--reopen-timeout' option requires a non-negative value\n";
    $reopen_timeout = 0;
  }

  if ($check_timeout < 0) {
    print STDERR "'--check-timeout' option requires a non-negative value\n";
    $check_timeout = 0;
  }

  if ($poll_timeout < 0) {
    print STDERR "'--poll-timeout' option requires a non-negative value\n";
    $poll_timeout = DEFAULT_POLLTIMEOUT;
  }

  if ($socket_timeout <= 0) {
    print STDERR "'--socket-timeout' option requires a positive value\n";
    $socket_timeout = DEFAULT_SOCKETTIMEOUT;
  }

  if ($blocksize <= 0) {
    print STDERR "'--blocksize' option requires a positive value\n";
    $blocksize = DEFAULT_BLOCKSIZE;
  }

  if ($bufsize < 0) {
    print STDERR "'--bufsize' option requires a non-negative value\n";
    $bufsize = 0;
  }

  if ($evstoresize < 0) {
    print STDERR "'--evstoresize' option requires a non-negative value\n";
    $evstoresize = 0;
  }

  if ($cleantime < 0) {
    print STDERR "'--cleantime' option requires a non-negative value\n";
    $cleantime = DEFAULT_CLEANTIME;
  }

  if (defined($logfile) && !length($logfile)) {
    print STDERR "'--log' option requires a non-empty value\n";
    $logfile = undef;
  }

  if (defined($syslogf) && !$SYSLOGAVAIL) {
    print STDERR "'--syslog' option requires Perl Sys::Syslog module\n";
    $syslogf = undef;
  }

  if (defined($syslogf) && !length($syslogf)) {
    print STDERR "'--syslog' option requires a non-empty value\n";
    $syslogf = undef;
  }

  if ($debuglevel < 1 || $debuglevel > 6) {
    print STDERR "'--debug' option requires a value from range 1..6\n";
    $debuglevel = 6;
  }

  if (defined($pidfile) && !length($pidfile)) {
    print STDERR "'--pid' option requires a non-empty value\n";
    $pidfile = undef;
  }

  if (!length($dumpfile)) {
    print STDERR "'--dump' option requires a non-empty value\n";
    $dumpfile = DEFAULT_DUMPFILE;
  }

  if (defined($username) && !length($username)) {
    print STDERR "'--user' option requires a non-empty value\n";
    $username = undef;
  }

  @values = grep(length($_), @groupnames);

  if (scalar(@values) < scalar(@groupnames)) {
    print STDERR "'--group' option requires a non-empty value\n";
    @groupnames = @values;
  }

  if (scalar(@groupnames) && !defined($username)) {
    print STDERR "'--group' option requires the '--user' option\n";
    @groupnames = ();
  }

  if (defined($umask) && ($umask < 0 || $umask > 511)) {
    print STDERR "'--umask' option requires a value from range 0..0777\n";
    $umask = undef;
  }

  if ($dumpfjson && !$JSONAVAIL) {
    print STDERR "'--dumpfjson' option requires Perl JSON::PP module\n";
    $dumpfjson = 0;
  }

  # in the case of --bufsize=1, always enable the --jointbuf option,
  # since there is no need to maintain multiple input buffers

  if ($bufsize == 1)  { $jointbuf = 1; }

  # restore the @ARGV array

  @ARGV = @argv_backup;

}


############################
# Function for the main loop
############################


# Parameters: -
# Action: the main loop - receive events from inputs and process them

sub main_loop {

  my($line, $evcont, $file);
  my($conffile, $childdata);

  for (;;) {

    # check the status of child processes, and poll them for new events if
    # the event buffer is empty (if a process has exited, all its remaining
    # events are read and appended to event buffer even if it is not empty)

    if (scalar(%children)) {
      $childdata = check_children();
    } else {
      $childdata = 0;
    }

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

    if (scalar(@events)) {
      $line = shift @events;
      $evcont = shift @events;
      $file = undef;
    } elsif (scalar(@readbuffer)) {
      $line = shift @readbuffer;
      $file = shift @readbuffer;
    } else {
      read_line($line, $file);
    }

    if (defined($line)) {

      # with --intcontexts option, set up internal context and store its
      # name to $intcontextname global variable (this variable will be used
      # for setting the $+{_intcontext} match variable)

      if ($intcontexts) {
        $intcontextname = defined($file)?$inputsrc{$file}->{"context"}:$evcont;
        $int_context->{"Aliases"}->{$intcontextname} = 1;
        $context_list{$intcontextname} = $int_context;
      }

      # update input buffers (they are implemented as circular buffers, since
      # according to benchmarks an array queue using shift and push is slower)
      # note that joint buffer is also maintained during --nojointbuf mode,
      # since @input_sources list is used for pattern matching purposes

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

      if (!$jointbuf) {
        if (defined($file)) {
          $input_buffers{$file}->{"BufPos"} = ($input_buffers{$file}->{"BufPos"} + 1) % $bufsize;
          $input_buffers{$file}->{"Events"}->[$input_buffers{$file}->{"BufPos"}] = $line;
        } else {
          $event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize;
          $event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $line;
        }
      }

      # clear pattern match cache

      %pmatch_cache = ();

      # process rules from configuration files

      foreach $conffile (@maincfiles) {
        if (process_rules($conffile)) { last; }
      }

      # with --intcontexts option, drop previously created internal context

      if ($intcontexts) {
        delete $context_list{$intcontextname};
        delete $int_context->{"Aliases"}->{$intcontextname};
        $intcontextname = undef;
      }

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

    } elsif (!$file) {

      # if --notail mode is active and all input files have been closed, exit;
      # if no new data was appended to input files, sleep with select(),
      # unless some child process returned data during last polling round

      if (!$tail && !grep($inputsrc{$_}->{"open"}, @inputfiles)) {

        # after generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT
        # seconds, so that child processes that were triggered by SEC_SHUTDOWN
        # have time to create a signal handler for SIGTERM if they wish

        if ($intevents) {
          internal_event("SEC_SHUTDOWN");
          if ($childterm)  { sleep(TERMTIMEOUT); }
        }

        if ($childterm)  { child_cleanup(); }
        exit(0);

      }

      # sleep if no new data were read from input files or child processes

      if (!$childdata)  { select(undef, undef, undef, $poll_timeout); }

    }

    # search lists for accomplishing timed tasks and removing obsolete elements

    if (time() - $lastcleanuptime >= $cleantime) {
      process_lists();
      $lastcleanuptime = time();
    }

    # check signal flags

    if ($sigreceived) {
      check_signals();
      $sigreceived = 0;
    }

  }
}


##################################################################
# ------------------------- MAIN PROGRAM -------------------------
##################################################################

### Set function pointers and create a template for internal contexts

$matchfunc[SUBSTR] = \&match_substr;
$matchfunc[REGEXP] = \&match_regexp;
$matchfunc[PERLFUNC] = \&match_perlfunc;
$matchfunc[CACHED] = \&match_cached;
$matchfunc[NSUBSTR] = \&match_nsubstr;
$matchfunc[NREGEXP] = \&match_nregexp;
$matchfunc[NPERLFUNC] = \&match_nperlfunc;
$matchfunc[NCACHED] = \&match_ncached;
$matchfunc[TVALUE] = \&match_tvalue;

$matchrulefunc[SINGLE] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_SCRIPT] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_SUPPRESS] = \&match_1pattern_rule;
$matchrulefunc[PAIR] = \&match_2pattern_rule;
$matchrulefunc[PAIR_W_WINDOW] = \&match_2pattern_rule;
$matchrulefunc[SINGLE_W_THRESHOLD] = \&match_1pattern_rule;
$matchrulefunc[SINGLE_W_2_THRESHOLDS] = \&match_1pattern_rule;
$matchrulefunc[EVENT_GROUP] = \&match_eventgroup_rule;
$matchrulefunc[SUPPRESS] = \&match_1pattern_rule;
$matchrulefunc[JUMP] = \&match_1pattern_rule;

$matchegrpfunc[SUBSTR] = \&match_eventgroup_substr;
$matchegrpfunc[REGEXP] = \&match_eventgroup_regexp;
$matchegrpfunc[PERLFUNC] = \&match_eventgroup_perlfunc;
$matchegrpfunc[NSUBSTR] = \&match_eventgroup_nsubstr;
$matchegrpfunc[NREGEXP] = \&match_eventgroup_nregexp;
$matchegrpfunc[NPERLFUNC] = \&match_eventgroup_nperlfunc;

$processrulefunc[SINGLE] = \&process_single_rule;
$processrulefunc[SINGLE_W_SCRIPT] = \&process_singlewithscript_rule;
$processrulefunc[SINGLE_W_SUPPRESS] = \&process_singlewithsuppress_rule;
$processrulefunc[PAIR] = \&process_pair_rule;
$processrulefunc[PAIR_W_WINDOW] = \&process_pairwithwindow_rule;
$processrulefunc[SINGLE_W_THRESHOLD] = \&process_singlewiththreshold_rule;
$processrulefunc[SINGLE_W_2_THRESHOLDS] = \&process_singlewith2thresholds_rule;
$processrulefunc[EVENT_GROUP] = \&process_eventgroup_rule;
$processrulefunc[JUMP] = \&process_jump_rule;

$actioncopyfunc[NONE] = \&copy_one_elem_action;
$actioncopyfunc[LOGONLY] = \&copy_two_elem_action;
$actioncopyfunc[WRITE] = \&copy_three_elem_action;
$actioncopyfunc[WRITEN] = \&copy_three_elem_action;
$actioncopyfunc[CLOSEF] = \&copy_two_elem_action;
$actioncopyfunc[OWRITECL] = \&copy_three_elem_action;
$actioncopyfunc[UDGRAM] = \&copy_three_elem_action;
$actioncopyfunc[CLOSEUDGR] = \&copy_two_elem_action;
$actioncopyfunc[USTREAM] = \&copy_three_elem_action;
$actioncopyfunc[CLOSEUSTR] = \&copy_two_elem_action;
$actioncopyfunc[UDPSOCK] = \&copy_three_elem_action;
$actioncopyfunc[CLOSEUDP] = \&copy_two_elem_action;
$actioncopyfunc[TCPSOCK] = \&copy_three_elem_action;
$actioncopyfunc[CLOSETCP] = \&copy_two_elem_action;
$actioncopyfunc[SHELLCOMMAND] = \&copy_two_elem_action;
$actioncopyfunc[COMMANDEXEC] = \&copy_cmdexec_spawnexec_action;
$actioncopyfunc[SPAWN] = \&copy_two_elem_action;
$actioncopyfunc[SPAWNEXEC] = \&copy_cmdexec_spawnexec_action;
$actioncopyfunc[CSPAWN] = \&copy_three_elem_action;
$actioncopyfunc[CSPAWNEXEC] = \&copy_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[PIPE] = \&copy_three_elem_action;
$actioncopyfunc[PIPEEXEC] = \&copy_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[CREATECONTEXT] = \&copy_create_set_action;
$actioncopyfunc[DELETECONTEXT] = \&copy_two_elem_action;
$actioncopyfunc[OBSOLETECONTEXT] = \&copy_two_elem_action;
$actioncopyfunc[SETCONTEXT] = \&copy_create_set_action;
$actioncopyfunc[ALIAS] = \&copy_three_elem_action;
$actioncopyfunc[UNALIAS] = \&copy_two_elem_action;
$actioncopyfunc[ADD] = \&copy_three_elem_action;
$actioncopyfunc[PREPEND] = \&copy_three_elem_action;
$actioncopyfunc[FILL] = \&copy_three_elem_action;
$actioncopyfunc[REPORT] = \&copy_three_elem_action;
$actioncopyfunc[REPORTEXEC] = \&copy_cspawnexec_pipeexec_reportexec_action;
$actioncopyfunc[COPYCONTEXT] = \&copy_three_elem_action;
$actioncopyfunc[EMPTYCONTEXT] = \&copy_three_elem_action;
$actioncopyfunc[POP] = \&copy_three_elem_action;
$actioncopyfunc[SHIFT] = \&copy_three_elem_action;
$actioncopyfunc[EXISTS] = \&copy_three_elem_action;
$actioncopyfunc[GETSIZE] = \&copy_three_elem_action;
$actioncopyfunc[GETALIASES] = \&copy_three_elem_action;
$actioncopyfunc[GETLIFETIME] = \&copy_three_elem_action;
$actioncopyfunc[SETLIFETIME] = \&copy_three_elem_action;
$actioncopyfunc[GETCTIME] = \&copy_three_elem_action;
$actioncopyfunc[SETCTIME] = \&copy_three_elem_action;
$actioncopyfunc[EVENT] = \&copy_three_elem_action;
$actioncopyfunc[TEVENT] = \&copy_three_elem_action;
$actioncopyfunc[CEVENT] = \&copy_four_elem_action;
$actioncopyfunc[RESET] = \&copy_four_elem_action;
$actioncopyfunc[GETWINPOS] = \&copy_five_elem_action;
$actioncopyfunc[SETWINPOS] = \&copy_five_elem_action;
$actioncopyfunc[ASSIGN] = \&copy_three_elem_action;
$actioncopyfunc[ASSIGNSQ] = \&copy_three_elem_action;
$actioncopyfunc[FREE] = \&copy_two_elem_action;
$actioncopyfunc[EVAL] = \&copy_three_elem_action;
$actioncopyfunc[CALL] = \&copy_call_action;
$actioncopyfunc[LCALL] = \&copy_lcall_action;
$actioncopyfunc[REWRITE] = \&copy_three_elem_action;
$actioncopyfunc[ADDINPUT] = \&copy_four_elem_action;
$actioncopyfunc[DROPINPUT] = \&copy_two_elem_action;
$actioncopyfunc[SIGEMUL] = \&copy_two_elem_action;
$actioncopyfunc[VARIABLESET] = \&copy_three_elem_action;
$actioncopyfunc[IF] = \&copy_if_action;
$actioncopyfunc[WHILE] = \&copy_while_action;
$actioncopyfunc[BREAK] = \&copy_one_elem_action;
$actioncopyfunc[CONTINUE] = \&copy_one_elem_action;

$actionsubstfunc[NONE] = \&subst_none_break_continue;
$actionsubstfunc[LOGONLY] = \&subst_two_elem_action;
$actionsubstfunc[WRITE] = \&subst_three_elem_action;
$actionsubstfunc[WRITEN] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEF] = \&subst_two_elem_action;
$actionsubstfunc[OWRITECL] = \&subst_three_elem_action;
$actionsubstfunc[UDGRAM] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUDGR] = \&subst_two_elem_action;
$actionsubstfunc[USTREAM] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUSTR] = \&subst_two_elem_action;
$actionsubstfunc[UDPSOCK] = \&subst_three_elem_action;
$actionsubstfunc[CLOSEUDP] = \&subst_two_elem_action;
$actionsubstfunc[TCPSOCK] = \&subst_three_elem_action;
$actionsubstfunc[CLOSETCP] = \&subst_two_elem_action;
$actionsubstfunc[SHELLCOMMAND] = \&subst_two_elem_action;
$actionsubstfunc[COMMANDEXEC] = \&subst_cmdexec_spawnexec_action;
$actionsubstfunc[SPAWN] = \&subst_two_elem_action;
$actionsubstfunc[SPAWNEXEC] = \&subst_cmdexec_spawnexec_action;
$actionsubstfunc[CSPAWN] = \&subst_three_elem_action;
$actionsubstfunc[CSPAWNEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[PIPE] = \&subst_three_elem_action;
$actionsubstfunc[PIPEEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[CREATECONTEXT] = \&subst_create_set_action;
$actionsubstfunc[DELETECONTEXT] = \&subst_two_elem_action;
$actionsubstfunc[OBSOLETECONTEXT] = \&subst_two_elem_action;
$actionsubstfunc[SETCONTEXT] = \&subst_create_set_action;
$actionsubstfunc[ALIAS] = \&subst_three_elem_action;
$actionsubstfunc[UNALIAS] = \&subst_two_elem_action;
$actionsubstfunc[ADD] = \&subst_three_elem_action;
$actionsubstfunc[PREPEND] = \&subst_three_elem_action;
$actionsubstfunc[FILL] = \&subst_three_elem_action;
$actionsubstfunc[REPORT] = \&subst_three_elem_action;
$actionsubstfunc[REPORTEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action;
$actionsubstfunc[COPYCONTEXT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[EMPTYCONTEXT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[POP] = \&subst_copy_empty_etc_action;
$actionsubstfunc[SHIFT] = \&subst_copy_empty_etc_action;
$actionsubstfunc[EXISTS] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETSIZE] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETALIASES] = \&subst_event_assign_etc_action;
$actionsubstfunc[GETLIFETIME] = \&subst_event_assign_etc_action;
$actionsubstfunc[SETLIFETIME] = \&subst_three_elem_action;
$actionsubstfunc[GETCTIME] = \&subst_event_assign_etc_action;
$actionsubstfunc[SETCTIME] = \&subst_three_elem_action;
$actionsubstfunc[EVENT] = \&subst_event_assign_etc_action;
$actionsubstfunc[TEVENT] = \&subst_three_elem_action;
$actionsubstfunc[CEVENT] = \&subst_four_elem_action;
$actionsubstfunc[RESET] = \&subst_reset_action;
$actionsubstfunc[GETWINPOS] = \&subst_getwpos_action;
$actionsubstfunc[SETWINPOS] = \&subst_setwpos_action;
$actionsubstfunc[ASSIGN] = \&subst_event_assign_etc_action;
$actionsubstfunc[ASSIGNSQ] = \&subst_event_assign_etc_action;
$actionsubstfunc[FREE] = \&subst_free;
$actionsubstfunc[EVAL] = \&subst_event_assign_etc_action;
$actionsubstfunc[CALL] = \&subst_call_action;
$actionsubstfunc[LCALL] = \&subst_lcall_action;
$actionsubstfunc[REWRITE] = \&subst_three_elem_action;
$actionsubstfunc[ADDINPUT] = \&subst_four_elem_action;
$actionsubstfunc[DROPINPUT] = \&subst_two_elem_action;
$actionsubstfunc[SIGEMUL] = \&subst_two_elem_action;
$actionsubstfunc[VARIABLESET] = \&subst_event_assign_etc_action;
$actionsubstfunc[IF] = \&subst_if_action;
$actionsubstfunc[WHILE] = \&subst_while_action;
$actionsubstfunc[BREAK] = \&subst_none_break_continue;
$actionsubstfunc[CONTINUE] = \&subst_none_break_continue;

$execactionfunc[NONE] = \&execute_none_action;
$execactionfunc[LOGONLY] = \&execute_logonly_action;
$execactionfunc[WRITE] = \&execute_write_action;
$execactionfunc[WRITEN] = \&execute_write_action;
$execactionfunc[CLOSEF] = \&execute_closef_action;
$execactionfunc[OWRITECL] = \&execute_owritecl_action;
$execactionfunc[UDGRAM] = \&execute_udgram_action;
$execactionfunc[CLOSEUDGR] = \&execute_closeudgr_action;
$execactionfunc[USTREAM] = \&execute_ustream_action;
$execactionfunc[CLOSEUSTR] = \&execute_closeustr_action;
$execactionfunc[UDPSOCK] = \&execute_udpsock_action;
$execactionfunc[CLOSEUDP] = \&execute_closeudp_action;
$execactionfunc[TCPSOCK] = \&execute_tcpsock_action;
$execactionfunc[CLOSETCP] = \&execute_closetcp_action;
$execactionfunc[SHELLCOMMAND] = \&execute_shellcmd_action;
$execactionfunc[COMMANDEXEC] = \&execute_cmdexec_action;
$execactionfunc[SPAWN] = \&execute_spawn_action;
$execactionfunc[SPAWNEXEC] = \&execute_spawnexec_action;
$execactionfunc[CSPAWN] = \&execute_cspawn_action;
$execactionfunc[CSPAWNEXEC] = \&execute_cspawnexec_action;
$execactionfunc[PIPE] = \&execute_pipe_action;
$execactionfunc[PIPEEXEC] = \&execute_pipeexec_action;
$execactionfunc[CREATECONTEXT] = \&execute_create_action;
$execactionfunc[DELETECONTEXT] = \&execute_delete_action;
$execactionfunc[OBSOLETECONTEXT] = \&execute_obsolete_action;
$execactionfunc[SETCONTEXT] = \&execute_set_action;
$execactionfunc[ALIAS] = \&execute_alias_action;
$execactionfunc[UNALIAS] = \&execute_unalias_action;
$execactionfunc[ADD] = \&execute_add_action;
$execactionfunc[PREPEND] = \&execute_prepend_action;
$execactionfunc[FILL] = \&execute_fill_action;
$execactionfunc[REPORT] = \&execute_report_action;
$execactionfunc[REPORTEXEC] = \&execute_reportexec_action;
$execactionfunc[COPYCONTEXT] = \&execute_copy_action;
$execactionfunc[EMPTYCONTEXT] = \&execute_empty_action;
$execactionfunc[POP] = \&execute_pop_action;
$execactionfunc[SHIFT] = \&execute_shift_action;
$execactionfunc[EXISTS] = \&execute_exists_action;
$execactionfunc[GETSIZE] = \&execute_getsize_action;
$execactionfunc[GETALIASES] = \&execute_getaliases_action;
$execactionfunc[GETLIFETIME] = \&execute_getltime_action;
$execactionfunc[SETLIFETIME] = \&execute_setltime_action;
$execactionfunc[GETCTIME] = \&execute_getctime_action;
$execactionfunc[SETCTIME] = \&execute_setctime_action;
$execactionfunc[EVENT] = \&execute_event_action;
$execactionfunc[TEVENT] = \&execute_tevent_action;
$execactionfunc[CEVENT] = \&execute_cevent_action;
$execactionfunc[RESET] = \&execute_reset_action;
$execactionfunc[GETWINPOS] = \&execute_getwpos_action;
$execactionfunc[SETWINPOS] = \&execute_setwpos_action;
$execactionfunc[ASSIGN] = \&execute_assign_action;
$execactionfunc[ASSIGNSQ] = \&execute_assignsq_action;
$execactionfunc[FREE] = \&execute_free_action;
$execactionfunc[EVAL] = \&execute_eval_action;
$execactionfunc[CALL] = \&execute_call_action;
$execactionfunc[LCALL] = \&execute_lcall_action;
$execactionfunc[REWRITE] = \&execute_rewrite_action;
$execactionfunc[ADDINPUT] = \&execute_addinput_action;
$execactionfunc[DROPINPUT] = \&execute_dropinput_action;
$execactionfunc[SIGEMUL] = \&execute_sigemul_action;
$execactionfunc[VARIABLESET] = \&execute_varset_action;
$execactionfunc[IF] = \&execute_if_action;
$execactionfunc[WHILE] = \&execute_while_action;
$execactionfunc[BREAK] = \&execute_break_action;
$execactionfunc[CONTINUE] = \&execute_continue_action;

### create a template that is shared by all internal contexts; note that
### the Internal flag blocks actions that modify the internal context

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

### ignore SIGPIPE (done before generating any output)

$SIG{PIPE} = 'IGNORE';

### Read and process SEC options from command line and resource file

read_options();

### If requested, print usage/version info and exit

if ($help) {
  print $SEC_USAGE;
  exit(0);
}

if ($version) {
  print $SEC_VERSION, "\n";
  print $SEC_COPYRIGHT, "\n";
  print $SEC_LICENSE;
  exit(0);
}

### If requested, change the user and group ID

if (defined($username))  { set_user_and_group_id(); }

### If requested, change the umask

if (defined($umask))  { set_umask(); }

### Start the logging

if (defined($logfile))  { open_logfile($logfile); }  else { $logopen = 0; }
if (defined($syslogf))  { open_syslog($syslogf); }  else { $syslogopen = 0; }

log_msg(LOG_NOTICE, "$SEC_VERSION");

### If --detach flag was specified, chdir to / for not disturbing future
### unmount of current filesystem. Must be done before read_config() to
### receive error messages about scripts that would not be found at runtime

if ($detach) {
  log_msg(LOG_NOTICE, "Changing working directory to /");
  chdir('/');
}

### Read in configuration

my $config_ok = read_config();

if ($testonly) {
  if ($config_ok)  { exit(0); }  else { exit(1); }
}

### if --bufsize command line option has not been provided or --bufsize=0,
### set --bufsize by analyzing loaded rules

if (!$bufsize)  { set_bufsize_option(); }

### Open input sources

if ($fromstart) { open_input(0); }
elsif ($tail) { open_input(-1); }
else { open_input(0); }

### Daemonize the process, if --detach flag was specified

if ($detach)  { daemonize(); }

### Create pidfile - must be done after daemonization

if (defined($pidfile))  { create_pidfile($pidfile); }

### Set signal handlers

$sigreceived = 0;

$refresh = 0;
$SIG{HUP} = \&hup_handler;

$softrefresh = 0;
$SIG{ABRT} = \&abrt_handler;

$dumpdata = 0;
$SIG{USR1} = \&usr1_handler;

$openlog = 0;
$SIG{USR2} = \&usr2_handler;

$debuglevelinc = 0;

if (override_sigint()) {
  $SIG{INT} = \&int_handler;
} else {
  log_msg(LOG_NOTICE,
  "Interactive process, SIGINT can't be used for changing the logging level");
}

%terminate = ();
$SIG{TERM} = \&term_handler;

### Set various global variables

$startuptime = time();
$processedlines = 0;

### Initialize input buffers

arrange_input_buffers();

### Initialize correlation list, context list,
### buffer list, and child process list

%corr_list = ();
%context_list = ();
%children = ();

### Initialize event buffers

@events = ();
@pending_events = ();

### Initialize builtin action list variables

$timevar_update = time();
set_actionlist_time_var($timevar_update);
set_actionlist_char_var();

### If --intevents flag was specified, create generate the SEC_STARTUP event

if ($intevents)  { internal_event("SEC_STARTUP"); }

### search lists for accomplishing timed tasks and removing obsolete elements
### (triggers Calendar rules, must be done between SEC_STARTUP and main loop)

process_lists();
$lastcleanuptime = time();

### read lines from input stream and process them

main_loop();